Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Печать в PDF по обозначенному диапазону имен листов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Печать в PDF по обозначенному диапазону имен листов (Формулы/Formulas)
Печать в PDF по обозначенному диапазону имен листов
Acerzx9456 Дата: Четверг, 09.05.2024, 18:02 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Добрый день, помогите пожалуйста разобраться с макросом печати.

1) Основная необходимость - это печать по кнопке в PDF одним файлом в фиксированную папку, с заданием имени или текущей датой, перечня обозначенных листов книги, имена требуемых листов некоторым образом отбираются из некоторой таблицы и заполняют строку 2 - изображение 1

В таблице по строке 2 могут быть как пропуски, так и замены из другого диапазона имен листов (есть листы с именами от 1 до 10 и от Т1 до Т5) - изображение 2

2) Затем некоторая сводка информации со всех листов попадает на лист Ш, где требуется динамическая область печати с шагом по столбцам, в отдельный файл, также с заданием имени или текущей датой, но с припиской "_ш" (в примере до столбца G, так как далее уже нет информации) - изображение 3

Суммирую последовательность действий после нажатия на кнопку исполняющую макрос:

всплывает диалоговое окно, запрашивающее имя общего файла PDF требуемых листов под печать (или сразу автоматом ставит в имя файла текущую дату), затем печатает все обозначенные листы из строки 2 с листа "Исходник", затем динамически определяется область печати на листе "Ш" и также печатается в PDF, как предыдущий файл + приписка "_ш".

Спасибо всем, кто сможет помочь.
К сообщению приложен файл: 7704142.jpg (11.6 Kb) · 0655010.jpg (6.1 Kb) · 6351357.jpg (40.2 Kb) · primer.xlsm (25.5 Kb)
 
Ответить
СообщениеДобрый день, помогите пожалуйста разобраться с макросом печати.

1) Основная необходимость - это печать по кнопке в PDF одним файлом в фиксированную папку, с заданием имени или текущей датой, перечня обозначенных листов книги, имена требуемых листов некоторым образом отбираются из некоторой таблицы и заполняют строку 2 - изображение 1

В таблице по строке 2 могут быть как пропуски, так и замены из другого диапазона имен листов (есть листы с именами от 1 до 10 и от Т1 до Т5) - изображение 2

2) Затем некоторая сводка информации со всех листов попадает на лист Ш, где требуется динамическая область печати с шагом по столбцам, в отдельный файл, также с заданием имени или текущей датой, но с припиской "_ш" (в примере до столбца G, так как далее уже нет информации) - изображение 3

Суммирую последовательность действий после нажатия на кнопку исполняющую макрос:

всплывает диалоговое окно, запрашивающее имя общего файла PDF требуемых листов под печать (или сразу автоматом ставит в имя файла текущую дату), затем печатает все обозначенные листы из строки 2 с листа "Исходник", затем динамически определяется область печати на листе "Ш" и также печатается в PDF, как предыдущий файл + приписка "_ш".

Спасибо всем, кто сможет помочь.

Автор - Acerzx9456
Дата добавления - 09.05.2024 в 18:02
DrMini Дата: Четверг, 09.05.2024, 18:40 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1678
Репутация: 226 ±
Замечаний: 0% ±

Excel LTSC 2024 RUS
 
Ответить
СообщениеКРОСС.

Автор - DrMini
Дата добавления - 09.05.2024 в 18:40
Pelena Дата: Четверг, 09.05.2024, 19:44 | Сообщение № 3
Группа: Админы
Ранг: Местный житель
Сообщений: 19197
Репутация: 4423 ±
Замечаний: ±

Excel 365 & Mac Excel
Если порядок листов в файле pdf имеет значение, то можно так
[vba]
Код
Public Sub ExpPDF()
    Dim t As Workbook, lc As Long, i As Long, k As Long, nm as String
    'On Error Resume Next
    Set t = ThisWorkbook
    Application.ScreenUpdating = False
    With ActiveSheet
        lc = .Cells(2, .Columns.Count).End(xlToLeft).Column
        ReDim arr(1 To 1)

        For i = 1 To lc
            If .Cells(2, i) <> "" Then
                k = k + 1
                If k = 1 Then t.Sheets(CStr(.Cells(2, i))).Copy Else t.Sheets(CStr(.Cells(2, i))).Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
            End If
        Next i
        If k = 0 Then Exit Sub
    End With

    nm = ThisWorkbook.Path & "\" & Format(Now, "DDMMYY_hhnnss") & ".pdf"    ' имяфайла и путь целиком

    On Error Resume Next
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nm, Quality:=xlQualityStandard _
                    , IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False

    ActiveWorkbook.Close False

    With t.Sheets("Ш")
        i = 1
        Do While .Cells(2, i) <> ""
            If .Cells(2, i) = 0 Then .Columns(i).Hidden = True Else .Columns(i).Hidden = False
            i = i + 1
        Loop
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=nm & "_Ш", Quality:=xlQualityStandard _
                           , IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False

        .Columns.Hidden = False
    End With
    
    On Error GoTo 0
    Application.ScreenUpdating = True

End Sub
[/vba]
К сообщению приложен файл: primer2.xlsm (47.6 Kb)


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЕсли порядок листов в файле pdf имеет значение, то можно так
[vba]
Код
Public Sub ExpPDF()
    Dim t As Workbook, lc As Long, i As Long, k As Long, nm as String
    'On Error Resume Next
    Set t = ThisWorkbook
    Application.ScreenUpdating = False
    With ActiveSheet
        lc = .Cells(2, .Columns.Count).End(xlToLeft).Column
        ReDim arr(1 To 1)

        For i = 1 To lc
            If .Cells(2, i) <> "" Then
                k = k + 1
                If k = 1 Then t.Sheets(CStr(.Cells(2, i))).Copy Else t.Sheets(CStr(.Cells(2, i))).Copy After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
            End If
        Next i
        If k = 0 Then Exit Sub
    End With

    nm = ThisWorkbook.Path & "\" & Format(Now, "DDMMYY_hhnnss") & ".pdf"    ' имяфайла и путь целиком

    On Error Resume Next
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nm, Quality:=xlQualityStandard _
                    , IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                    OpenAfterPublish:=False

    ActiveWorkbook.Close False

    With t.Sheets("Ш")
        i = 1
        Do While .Cells(2, i) <> ""
            If .Cells(2, i) = 0 Then .Columns(i).Hidden = True Else .Columns(i).Hidden = False
            i = i + 1
        Loop
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=nm & "_Ш", Quality:=xlQualityStandard _
                           , IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                             OpenAfterPublish:=False

        .Columns.Hidden = False
    End With
    
    On Error GoTo 0
    Application.ScreenUpdating = True

End Sub
[/vba]

Автор - Pelena
Дата добавления - 09.05.2024 в 19:44
Acerzx9456 Дата: Пятница, 10.05.2024, 13:19 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Спасибо за скорый ответ!
В первом приближении, после адаптации под себя, все прекрасно работает! Изящное решение - через копирование в новую книгу.

Подскажите один момент, если мне надо сперва создавать папку с именем даты, в которую потом будут помещаться файлы PDF, так будет верно или есть решение лучше?

[vba]
Код
    np = "C:\Users\...\Печать" & "\" & Format(Now, "DD.MM.YY")

    If Dir(np, vbDirectory) = "" Then MkDir np
    
    nm = "C:\Users\...\Печать" & "\" & Format(Now, "DD.MM.YY") & "\" & Format(Now, "DD.MM.YY")
[/vba]
 
Ответить
СообщениеСпасибо за скорый ответ!
В первом приближении, после адаптации под себя, все прекрасно работает! Изящное решение - через копирование в новую книгу.

Подскажите один момент, если мне надо сперва создавать папку с именем даты, в которую потом будут помещаться файлы PDF, так будет верно или есть решение лучше?

[vba]
Код
    np = "C:\Users\...\Печать" & "\" & Format(Now, "DD.MM.YY")

    If Dir(np, vbDirectory) = "" Then MkDir np
    
    nm = "C:\Users\...\Печать" & "\" & Format(Now, "DD.MM.YY") & "\" & Format(Now, "DD.MM.YY")
[/vba]

Автор - Acerzx9456
Дата добавления - 10.05.2024 в 13:19
Pelena Дата: Пятница, 10.05.2024, 13:34 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 19197
Репутация: 4423 ±
Замечаний: ±

Excel 365 & Mac Excel
Я бы так сделала
[vba]
Код
    On Error Resume Next
    np = "C:\Users\...\Печать\" & Format(Now, "DD_MM_YY")
    MkDir np
    nm = np & "\" & Format(Now, "DD_MM_YY") & ".pdf"
[/vba]
В имени папки точки лучше не использовать


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЯ бы так сделала
[vba]
Код
    On Error Resume Next
    np = "C:\Users\...\Печать\" & Format(Now, "DD_MM_YY")
    MkDir np
    nm = np & "\" & Format(Now, "DD_MM_YY") & ".pdf"
[/vba]
В имени папки точки лучше не использовать

Автор - Pelena
Дата добавления - 10.05.2024 в 13:34
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Печать в PDF по обозначенному диапазону имен листов (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!