Макрос excel для печати в pdf - Word и Excel - помощь в работе с программами

Сохранение в PDF книги Excel, группы листов, одного листа или отдельного диапазона с помощью кода VBA. Метод ExportAsFixedFormat. Примеры экспорта.

Метод ExportAsFixedFormat

Метод ExportAsFixedFormat сохраняет рабочую книгу Excel или выбранную группу листов этой книги в один PDF-файл. Чтобы экспортировать каждый лист в отдельный файл, необходимо применить метод ExportAsFixedFormat к каждому сохраняемому листу.

Синтаксис

Expression.ExportAsFixedFormat (Type, FileName, Quality, IncludeDocProperties, IgnorePrintAreas, From, To, OpenAfterPublish, FixedFormatExtClassPtr)

Expression – это выражение, представляющее объект Workbook, Worksheet или Range.

Параметры

Единственный обязательный параметр – Type, остальные можно не указывать – в этом случае будут применены значения по умолчанию.

Параметр	Описание
Type	Задает формат файла для экспорта книги или листа: xlTypePDF(0) – сохранение в файл PDF; xlTypeXPS(1) – сохранение в файл XPS*.
FileName	Задает имя файла. При указании полного пути, файл будет сохранен в указанную папку, при указании только имени – в папку по умолчанию (в Excel 2016 – «Документы»). Если имя не задано (по умолчанию), файл будет сохранен с именем экспортируемой книги.
Quality	Задает качество сохраняемых электронных таблиц: xlQualityMinimum(1) – минимальное качество; xlQualityStandard(0) – стандартное качество (по умолчанию).
IncludeDocProperties	Включение свойств документа Excel в PDF: True(1) – включить; False(0) – не включать; мне не удалось обнаружить разницу и значение по умолчанию.
IgnorePrintAreas	Указывает VBA, следует ли игнорировать области печати, заданные на листах файла Excel: True(1) – игнорировать области печати; False(0) – не игнорировать области печати (по умолчанию).
From**	Задает номер листа книги Excel, с которого начинается экспорт. По умолчанию сохранение в PDF начинается с первого листа книги.
To**	Задает номер листа книги Excel, на котором заканчивается экспорт. По умолчанию сохранение в PDF заканчивается на последнем листе книги.
OpenAfterPublish	Указывает VBA на необходимость открыть созданный файл PDF средством просмотра: True(1) – открыть файл PDF для просмотра; False(0) – не открывать файл PDF для просмотра (по умолчанию).
FixedFormatExtClassPtr	Указатель на класс FixedFormatExt (игнорируем этот параметр).

* XPS – это редко использующийся фиксированный формат файлов, разработанный Microsoft, который похож на PDF, но основан на языке XML.
** Применимо только к книге (Workbook.ExportAsFixedFormat), при экспорте листа (Worksheet.ExportAsFixedFormat) указание параметров From и/или To приведет к ошибке.

Сохранение в PDF книги Excel

Экспорт всей книги

Sub Primer1()

ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=«C:Testfile1.pdf», OpenAfterPublish:=True

End Sub

Если вы указываете путь к файлу, он должен существовать, иначе VBA сохранит файл с именем и в папку по умолчанию («ИмяКниги.pdf» в папку «Документы»).

Экспорт части книги

Этот способ позволяет сохранить в PDF группу листов, расположенных подряд:

Sub Primer2()

ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=«C:Testfile2.pdf», _

From:=2, To:=4, OpenAfterPublish:=True

End Sub

Сохранение в PDF рабочих листов

Экспорт одного листа

Sub Primer3()

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=«C:Testfile3.pdf», OpenAfterPublish:=True

End Sub

Экспорт диапазона

Sub Primer2()

Лист4.Range(«A1:F6»).ExportAsFixedFormat Type:=xlTypePDF, Filename:=«C:Testfile4.pdf», OpenAfterPublish:=True

End Sub

Если экспортируемый диапазон расположен на активном листе, имя листа указывать не обязательно.

Экспорт группы листов

Этот способ удобен тем, что экспортировать в PDF можно листы, расположенные не подряд:

Sub Primer5()

Sheets(Array(«Лист2», «Лист3», «Лист5»)).Select

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=«C:Testfile5.pdf», OpenAfterPublish:=True

End Sub

Источник

Формулировка задачи:

Добрый день!
На компьютере установлен пакет программ adobe, и в списке устройств имеется принтер adobe pdf, он установлен как принтер по умолчанию.
Имеется код макроса:

Создается .pdf Файл, но не открывается ни одной из подходящих для чтения pdf программ.
Если использовать следующий код:

,
то появляется диалоговое окно сохранения файла, и при указании пути назначения и имени файла, формируется корректный .pdf-файл.
В чём разница между двумя данными методами, и как обойти проблему формирования битого файла при использовании первого варианта макроса?

Код к задаче: «Печать pdf из excel-листа»

textual

Sub Макрос2()
    Лист1.PrintOut Copies:=1, ActivePrinter:="Microsoft Print to PDF (Ne02:)", _
        PrintToFile:=True, PrToFileName:="D:UsersANTON-SFDesktopTEST.PDF"
End Sub

Полезно ли:

8 голосов , оценка 4.000 из 5

Источник

daserdj

0 / 0 / 0

Регистрация: 13.10.2016

Сообщений: 2

06.11.2016, 16:11. Показов 12318. Ответов 3

Метки нет (Все метки)

Visual Basic

Sub pe4at()
 
ThisWorkbook.Worksheets("Лист1").PrintOut , printtofile:=True, prtofilename:=ThisWorkbook.Worksheets("Лист1").Name & ".pdf"
 
End Sub

Создается .pdf Файл, но не открывается ни одной из подходящих для чтения pdf программ.

Если использовать следующий код:

Visual Basic

Sub pe4at()
 
ThisWorkbook.Worksheets("Лист1").PrintOut
', printtofile:=True, prtofilename:=ThisWorkbook.Worksheets("Лист1").Name & ".pdf"
 
End Sub

15136 / 6410 / 1730

Регистрация: 24.09.2011

Сообщений: 9,999

07.11.2016, 00:09

daserdj, Офис 2007 и более новые имеют встроенные средства для сохранения в PDF. Запишите макрорекордером команду Файл — Сохранить как — тип файла: PDF, Параметры, опубликовать: выделенные листы, ОК.
Так в 2010. В 2007 кнопкаОфис — Сохранить как — PDF или XPS, дальше так же.

0 / 0 / 0

Регистрация: 13.10.2016

Сообщений: 2

07.11.2016, 14:24

[ТС]

Казанский, спасибо за ответ!
Подскажите, пожалуйста, как можно данный метод «скрестить» с командой PrintOut, — чтобы, с помощью макроса, перехватывать всплывающее после выполнения PrintOut диалоговое окно, указывать имя файла из переменной и путь, и сохранять? Попробовал запись макроса — в записанном коде диалоговое окно никак не упоминается.

anton-sf

123 / 59 / 14

Регистрация: 29.03.2015

Сообщений: 265

08.11.2016, 10:46

Из метода, предложенного Казанский, получается макрос, например у меня такой

Visual Basic

Sub Макрос1()
    Application.ActivePrinter = "Microsoft Print to PDF (Ne02:)"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
End Sub

Из этого макроса видно название PDF принтера — его и надо использовать:

Visual Basic

Sub Макрос2()
    Лист1.PrintOut Copies:=1, ActivePrinter:="Microsoft Print to PDF (Ne02:)", _
        PrintToFile:=True, PrToFileName:="D:UsersANTON-SFDesktopTEST.PDF"
End Sub

Источник

Return to VBA Code Examples

This tutorial will demonstrate how to save / print to a PDF in Excel VBA.

Print to PDF

This simple procedure will print the ActiveSheet to a PDF.

Sub SimplePrintToPDF()

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="demo.pdf", Quality:=xlQualityStandard, _
  IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

I’ve also created a function with error handling, etc. that will print the ActiveSheet to a PDF:

Sub PrintPDF()
    Call Save_PDF
End Sub


Function Save_PDF() As Boolean  ' Copies sheets into new PDF file for e-mailing
    Dim Thissheet As String, ThisFile As String, PathName As String
    Dim SvAs As String

Application.ScreenUpdating = False

' Get File Save Name
    Thissheet = ActiveSheet.Name
    ThisFile = ActiveWorkbook.Name
    PathName = ActiveWorkbook.Path
    SvAs = PathName & "" & Thissheet & ".pdf"

'Set Print Quality
    On Error Resume Next
    ActiveSheet.PageSetup.PrintQuality = 600
    Err.Clear
    On Error GoTo 0

' Instruct user how to send
    On Error GoTo RefLibError
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
    
SaveOnly:
    MsgBox "A copy of this sheet has been successfully saved as a  .pdf  file: " & vbCrLf & vbCrLf & SvAs & _
        "Review the .pdf document. If the document does NOT look good, adjust your printing parameters, and try again."
        
    Save_PDF = True
    GoTo EndMacro
    
RefLibError:
    MsgBox "Unable to save as PDF. Reference library not found."
    Save_PDF = False
EndMacro:
End Function

The function returns TRUE or FALSE if the print to PDF was successful or not.

Save and Email PDF Function

This function will save the ActiveSheet as a PDF and (optionally) attach the PDF to an email (assuming you have Outlook installed):

Sub Test_Save_PDF()
    Call Send_PDF("SendEmail")
End Sub


Function Send_PDF(Optional action As String = "SaveOnly") As Boolean  ' Copies sheets into new PDF file for e-mailing
    Dim Thissheet As String, ThisFile As String, PathName As String
    Dim SvAs As String

Application.ScreenUpdating = False

' Get File Save Name
    Thissheet = ActiveSheet.Name
    ThisFile = ActiveWorkbook.Name
    PathName = ActiveWorkbook.Path
    SvAs = PathName & "" & Thissheet & ".pdf"

'Set Print Quality
    On Error Resume Next
    ActiveSheet.PageSetup.PrintQuality = 600
    Err.Clear
    On Error GoTo 0

' Instruct user how to send
    On Error GoTo RefLibError
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SvAs, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=True
    On Error GoTo 0
    
' Send Email
    If action = "SendEmail" Then
        On Error GoTo SaveOnly
        Set olApp = CreateObject("Outlook.Application")
        Set olEmail = olApp.CreateItem(olMailItem)
        
        With olEmail
            .Subject = Thissheet & ".pdf"
            .Attachments.Add SvAs
            .Display
        End With
        On Error GoTo 0
        GoTo EndMacro
    End If
    
SaveOnly:
    MsgBox "A copy of this sheet has been successfully saved as a  .pdf  file: " & vbCrLf & vbCrLf & SvAs & _
        "Review the .pdf document. If the document does NOT look good, adjust your printing parameters, and try again."
        
    Send_PDF = True
    GoTo EndMacro
    
RefLibError:
    MsgBox "Unable to save as PDF. Reference library not found."
    Send_PDF = False
EndMacro:
End Function

VBA Coding Made Easy

Stop searching for VBA code online. Learn more about AutoMacro — A VBA Code Builder that allows beginners to code procedures from scratch with minimal coding knowledge and with many time-saving features for all users!

Learn More!

Источник

Макрос печатать листы в пдф, как сохранять название?

Dersarius

Дата: Понедельник, 16.03.2015, 22:28 |
Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 35

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Ребят подскажите, через рекордер записал макрос, устраивает, но зараза не могу понять как прописать в этом макросе когда идет печать в ПДФ чтобы название файлов все всремя разное было, а то получается перезаписывает друг друга после печати =((((
В итоге вопрос =)))) как сделать что бы при выходе название все время менялось например 1, потом 2 и т.д =)))
Извените за тупость, тяжко новичкам =((

И можно ли чтобы название с ячейки макрос брал в название файла прописывал?

[vba]

Код

Sub Макрос1()
‘
‘ Макрос1
‘

‘
Sheets(«лист1»).Select
Sheets(«лист2»).Visible = True
Sheets(«лист2»).Select
Range(«J15:M15»).Select
ChDir _
«C:Новая папка»
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
«C:Новая папкафайл.pdf» _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Range(«A1:Y57»).Select
Sheets(«лист2»).Select
ActiveWindow.SelectedSheets.Visible = False
End Sub

[/vba]

Сообщение отредактировал Dersarius — Понедельник, 16.03.2015, 22:56

Ответить

KSV

Дата: Вторник, 17.03.2015, 03:04 |
Сообщение № 2

Группа: Друзья

Ранг: Ветеран

Сообщений: 770

Репутация:
255
±

Замечаний:
0% ±

Excel 2013

как сделать что бы при выходе название все время менялось например 1, потом 2 и т.д

например, так:
[vba]

Код

i = i + 1
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= «C:Новая папкаФайл_» & i & «.pdf», Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas :=False, OpenAfterPublish:=False

[/vba]
а в самом начале, перед строкой «Sub Макрос1()», добавь:
[vba][/vba]

И можно ли чтобы название с ячейки макрос брал в название файла прописывал?

тогда, так:
[vba]

Код

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= «C:Новая папка» & Sheets(«лист2»).Range(«A1»).Value & «.pdf», Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas :=False, OpenAfterPublish:=False

[/vba]
имя файла будет взято из ячейки A1 лист2
но если ячейка A1 будет пустая или содержать недопустимые символы, то при экспорте выдаст ошибку.

KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

Сообщение отредактировал KSV — Вторник, 17.03.2015, 03:06

Ответить

Dersarius

Дата: Вторник, 17.03.2015, 10:45 |
Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 35

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Спасибо большое помогло, а можно по этому макросу сделать чтобы с двух ячеек имя складывалось файла, например брать с А1 и В2

[vba]

Код

[/vba]

Сообщение отредактировал Dersarius — Вторник, 17.03.2015, 10:57

Ответить

KSV

Дата: Вторник, 17.03.2015, 11:17 |
Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 770

Репутация:
255
±

Замечаний:
0% ±

Excel 2013

чтобы с двух ячеек имя складывалось файла, например брать с А1 и В2

[vba]

Код

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= «C:Новая папка» & Sheets(«лист2»).Range(«A1»).Value & Sheets(«лист2»).Range(«B2»).Value & «.pdf», Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas :=False, OpenAfterPublish:=False

[/vba]

KSV.VBA@gmail.com
Яндекс.Деньги: 410011921213333

Ответить

Dersarius

Дата: Вторник, 17.03.2015, 11:25 |
Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 35

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Ругается, Документ не сохранен. Возможно документ открыт или при сохранение возникла ошибка

Ответить

Dersarius

Дата: Вторник, 17.03.2015, 11:30 |
Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 35

Репутация:
0
±

Замечаний:
0% ±

Excel 2010

Извиняюсь все нормально, не допустимое значение было в ячейки, спасибо все работает

Ответить

Источник

pinguindell

Пользователь

Сообщений: 200
Регистрация: 01.01.1970

03.08.2016 15:28:47

Добрый день уважаемые знатоки VBA

Есть задача — необходимо при нажатии на кнопку Печать на листе, чтобы макрос отправлял на печать pdf файлы, ссылки на которые размещены в столбце А.
Я написал макрос и все работает и печатает, но макрос открывает каждый файл по отдельности, что очень не удобно, особенно если файлов 20 и более.

Код

Sub SetupBtn()
    ActiveSheet.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Select
    PrintHyperlinkedPDFs
 
End Sub


Sub PrintHyperlinkedPDFs()

Dim PDFrng As Range, PDF As Range
Dim AdobeReader As String, pdfLINK As String
                                        'there is an extra space at the end of this string
AdobeReader = "C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe"
Set PDFrng = Selection                  'change this to whatever method you want for setting
                                        'the range of PDF link cells to process and print
For Each PDF In PDFrng
    If PDF.Hyperlinks.Count > 0 Then pdfLINK = PDF.Hyperlinks(1).Address
    Shell """" & AdobeReader & """/n /t """ & pdfLINK & """"
Next PDF

Selection.Cells(1).Select
End Sub

Есть ли возможность отправлять файлы на печать не открывая сами файлы в Adobe ?

Спасибо за ответы

P.S. гиперссылки в файле битые, т.к. у каждого на компьютере будет собственный путь.

Прикрепленные файлы

Print pdf.zip (29.21 КБ)

JeyCi

Пользователь

Сообщений: 3357
Регистрация: 27.11.2013

04.08.2016 07:13:32

Цитата
pinguindell написал: Есть ли возможность отправлять файлы на печать не открывая сами файлы в Adobe ?

Нет

чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок — обратитесь к собеседнику на ВЫ — ответ на ваш вопрос получите — а остальное вас не касается (п.п.п. на форумах)

marchenkoan

Пользователь

Сообщений: 59
Регистрация: 18.07.2016

04.08.2016 07:47:19

Попробуйте вот так:

Код
Dim objShell Set objShell = CreateObject("Shell.Application") objShell.ShellExecute "имя_файла", "", "", "print", 0 WScript.Sleep 1000

pinguindell

Пользователь

Сообщений: 200
Регистрация: 01.01.1970

05.08.2016 07:22:56

marchenkoan,спасибо большое! практически то что нужно, но только мне пришлось немного адаптировать Ваш код под свой. Вот, может кому то и пригодиться:

Следующий код повесил на кнопку на листе, чтобы он выделял область ячеек с гиперссылками на файлы:

Код
Sub SetupBtn() ActiveSheet.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Select PrintHyperlinkedPDFs End Sub

затем сам код, отвечающий за печать файлов pdf по гиперссылкам:

Код

Sub PrintHyperlinkedPDFs()

Dim PDFrng As Range, PDF As Range
Dim AdobeReader As String, pdfLINK As String

Dim objShell
Set objShell = CreateObject("Shell.Application")
                                        
AdobeReader = "C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe"
Set PDFrng = Selection                                                                                               
                                        
For Each PDF In PDFrng
    If PDF.Hyperlinks.Count > 0 Then pdfLINK = PDF.Hyperlinks(1).Address
   
objShell.ShellExecute pdfLINK, "", "", "print", 0

Application.Wait Now + TimeValue("00:00:01")

Next PDF

Selection.Cells(1).Select


End Sub

ну и еще один код, который я повесил на событие закрытия книги, он позволяет при закрытии excel файла, закрыть все окна Adobe Reader, которое остались на панели задач.

Код

Sub Kill_All_PDFs()

   On Error Resume Next

    Dim objectWMI As Object
    Dim objectProcess As Object
    Dim objectProcesses As Object

    Set objectWMI = GetObject("winmgmts://.")
    Set objectProcesses = objectWMI.ExecQuery( _
        "SELECT * FROM Win32_Process WHERE Name = 'AcroRd32.exe'") '< Change if you need be


    For Each objectProcess In objectProcesses
        Call objectProcess.Terminate
    Next

    Set objectProcesses = Nothing
    Set objectWMI = Nothing
End Sub

Изменено: pinguindell — 05.08.2016 07:23:36

pinguindell

Пользователь

Сообщений: 200
Регистрация: 01.01.1970

24.08.2016 12:47:18

Уважаемые знатоки VBA, в очередной раз прошу Вашей помощи, в чем может быть проблема.

Макрос работает и все хорошо, но почему то печать происходит не по порядку расположения файлов в диапазоне — на печать должны идти файлы в следующей последовательности: Часть 1, Часть 2, Часть 3, Часть 4, а они идут как Часть1, Часть 4, Часть 3, Часть2

Я немного изменил код и теперь он выглядит так:

Код

Sub tt()

ActiveSheet.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Select


Dim PDFrng As Range, PDF As Range
Dim AdobeReader As String, pdfLINK As String

Dim objShell
Set objShell = CreateObject("Shell.Application")
                                        'there is an extra space at the end of this string
AdobeReader = "C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe"
Set PDFrng = Selection                  'change this to whatever method you want for setting
                                        
                                        
                                        'the range of PDF link cells to process and print
For Each PDF In PDFrng
If PDF.Hyperlinks.Count > 0 Then pdfLINK = PDF.Hyperlinks(1).Address
   
objShell.ShellExecute pdfLINK, "", "", "print", 0

Application.Wait Now + TimeValue("00:00:01")


Next PDF


End Sub

В чем может быть проблема ?.

Прикрепленные файлы

Print Pdf.zip (47.91 КБ)

Изменено: pinguindell — 25.08.2016 12:09:05

	Уважаемые форумчане, помогите пожалуйста с решением, мучаюсь не одну неделю …

JeyCi

Пользователь

Сообщений: 3357
Регистрация: 27.11.2013

04.09.2016 08:25:19

а жёстко задать счётчик не пробовали?

Код
Set sh = Activesheet For i = 1 To Selection.Cells.Count

и в sh.Cells(i,1) — обращайтесь к гиперссылке… были примеры на форуме… и здесь:

Как получить адрес гиперссылки из ячейки

p.s. ссылок в файле нет, тестить на принтере в любом случае не хочу… просто версия

Изменено: JeyCi — 04.09.2016 08:28:33

pinguindell

Пользователь

Сообщений: 200
Регистрация: 01.01.1970

05.09.2016 15:37:30

JeyCi,спасибо за совет. Попробовал сделать так как Вы сказали, получилось следующее (код ниже), но почему то код выдает ошибку Object required
Гиперссылки в файл добавил, нужно просто из архива извлечь папку Temp на локальный диск С

Код

Sub tt()

Dim PDFrng As Range, PDF As Range
Dim AdobeReader As String, pdfLINK As String

Dim objShell
Set objShell = CreateObject("Shell.Application")
Set sh = ActiveSheet

AdobeReader = "C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe"


ActiveSheet.Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Select
For i = 1 To Selection.Cells.Count

pdfLINK = Get_Hyperlink_Address(i)
 
objShell.ShellExecute pdfLINK, "", "", "print", 0

Application.Wait Now + TimeValue("00:00:01")


Next i

End Sub

Прикрепленные файлы

Print_2.zip (48.64 КБ)

kuklp

Пользователь

Сообщений: 14868
Регистрация: 21.12.2012

E-mail и реквизиты в профиле.

05.09.2016 16:22:20

Цитата
pinguindell написал: Попробовал сделать так

Так да не так. Что Вы скармливаете функции? Значения счетчика, i. А ей надобен: ByVal rCell As Range. Ячейка то бишь. Вот она и матерится, подай ей объект анонсированный в оглавлении. Типа: pdfLINK = Get_Hyperlink_Address(Cells(i)). И еще. Что по вашему у Вас делает строка:

Код
AdobeReader = "C:Program Files (x86)AdobeReader 11.0ReaderAcroRd32.exe"

, да и вообще всЯ эта переменная?

Я сам — дурнее всякого примера! …

pinguindell

Пользователь

Сообщений: 200
Регистрация: 01.01.1970

#10

06.09.2016 12:24:06

Уважаемые форумчане, спасибо за Ваши советы, переписал код следующим образом, и счетчик поставил и удалил не нужное, но печать все равно идет не последовательно.

Код

Sub tt()


Dim objShell
Set objShell = CreateObject("Shell.Application")
Set sh = ActiveSheet

Set sh = ActiveSheet
For i = 1 To 5

objShell.ShellExecute sh.Cells(i, 1), "", "", "print", 0

Next i

Application.Wait Now + TimeValue("00:00:01")

End Sub

В чем теперь может быть проблема ?

Прикрепленные файлы

Print_3.zip (53.81 КБ)

ZVI

Пользователь

Сообщений: 4328
Регистрация: 23.12.2012

#11

06.09.2016 13:02:33

В коде сообщения #1 в конце используйте такой вариант

Код
If PDF.Hyperlinks.Count > 0 Then pdfLINK = PDF.Hyperlinks(1).Address Shell """" & AdobeReader & """ /p /h """ & pdfLINK & """" End If

ZVI

Пользователь

Сообщений: 4328
Регистрация: 23.12.2012

Но, по сути, это то же самое, что делает ShellExecute, то есть проблема с очередностью останется.
Здесь есть противоречие: чтобы очередность соблюдалась, нужно дожидаться снятия занятости принтера, а это, насколько я понимаю, не удобно.

ZVI,попробовал использовать Ваш вариант, но почему то на печать отправляется только первый документ в списке.
В принципе проблем с печатью нет, проблема теперь в том, что макрос печатет документы не по порядку, а в разной последовательности

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

#14

06.09.2016 13:30:57

Цитата
pinguindell написал: макрос печатет документы не по порядку, а в разной последовательности

А это критично?

Jack Famous

Пользователь

Сообщений: 10852
Регистрация: 07.11.2014

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

Юрий М, доброго дня! Слежу за темой…и в моём случае это было бы критично, т.к., например, по таблице печати может быть составлен реестр документов. В таком случае ,естественно, хотелось бы отправить на печать и потом просто положить в папку с реестром ,зная, что там всё в том же порядке.

Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄

Юрий М

Модератор

Сообщений: 60585
Регистрация: 14.09.2012

Контакты см. в профиле

Смысл понятен, но, как мне кажется, главная задача — именно вывод на печать — решена )) В крайнем случае не составит большого труда разложить листы в нужной последовательности ))
Припоминается, что в своё время в одном из макросов открывал циклом поочерёдно несколько файлов и тоже не мог добиться правильной очередности их открытия
Уже не помню точно, но, кажется, цикл «выбирал» их в папке, исходя из сортировки по дате редактирования. Может и здесь такая же история? )

Jack Famous

Пользователь

Сообщений: 10852
Регистрация: 07.11.2014

OS: Win 8.1 Корп. x64 | Excel 2016 x64: | Browser: Chrome

Юрий М, а я (так как не силён в VBA):
1. копирую папку со всеми документами в каждый раздел
2. через таблицу соответствий в Excel и Multex от Дмитрия The_Prist переименовываю (в № по порядку) файлы в каждом разделе (это же по сути и будет реестром)
3. объединяю файлы внутри каждого раздела в 1 PDF
4. объединяю разделы ещё в 1 PDF и уже этот «монстр» печатается (минут 40) и всё в строгом порядке по реестру))))

Изменено: Jack Famous — 06.09.2016 15:08:06

JeyCi

Пользователь

Сообщений: 3357
Регистрация: 27.11.2013

#18

06.09.2016 15:21:23

Цитата
pinguindell написал: ZVI ,попробовал использовать Ваш вариант

а что насчёт этого?

Цитата
ZVI написал: чтобы очередность соблюдалась, нужно дожидаться снятия занятости принтера

я тоже думаю, что дело в этом… т.е. в #10 вы циклом запускаете всё поочерёдно по адресам из ячеек в нужной последовательности…
(1) но когда заканчивает печататься первый, то циклом уже запущен 4-й… имхо… не понятно почему вы 15-ю строку расположили в конце макроса, за циклом… если паузу делать внутри цикла, возможно будет соблюдаться нужный порядок… но размер паузы не знаю…
(2) т.к. ещё вариант объяснения — размер файла — пока принтер примет его к печати — это зависит от размера? (чем больше листов, тем дольше принтер сканируе себе в память всё, что ему надо напечатать из этого файла)?.. тогда тот же выход — паузу (возможно побольше) и внутрь цикла, чтобы всё успевало становиться в свою очередь…
как гипотеза… вы можете проверить)) я принтер мучать не буду

Изменено: JeyCi — 06.09.2016 15:48:33

ZVI

Пользователь

Сообщений: 4328
Регистрация: 23.12.2012

#19

06.09.2016 19:24:22

JeyCi права насчет паузы внутри цикла. Подберите таймаут в коде ниже:

Код

Sub Test()

  Const TIMEOUT = 2  '<-- Пауза в секундах после распечатки документа

  Dim i As Long, Sh As Worksheet, t As Single
  Set Sh = ActiveSheet
  With CreateObject("Shell.Application")
    For i = 1 To 5
      ' Печатать
      .ShellExecute Sh.Cells(i, 1).Value, "", "", "print", 0&
      ' Подождать
      t = Timer + TIMEOUT
      While Timer < t
        DoEvents
      Wend
    Next
  End With

End Sub

Изменено: ZVI — 06.09.2016 19:26:11

	ZVI, спасибо большое. Единственный вопрос — как для Const TIMEOUT = 2 ‘<— Пауза в секундах после распечатки документа присваивать значение из ячейки ? К примеру О2 текущего листа ?

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

#21

07.09.2016 13:19:52

pinguindell, замените:

Код
Const TIMEOUT = 2

на:

Код
dim TIMEOUT TIMEOUT = activesheet.range("О2").value

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

pinguindell

Пользователь

Сообщений: 200
Регистрация: 01.01.1970

#22

07.09.2016 13:38:45

JayBhagavan,

изменил код на предложенный

Код

Dim TIMEOUT
TIMEOUT = ActiveSheet.Range("О1").Value
 
  Dim i As Long, Sh As Worksheet, t As Single
  Set Sh = ActiveSheet
  lastRow = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row
  
  With CreateObject("Shell.Application")
    For i = 3 To lastRow
      ' Печатать
      .ShellExecute Sh.Cells(i, 9).Value, "", "", "print", 0&
      ' Подождать
      t = Timer + TIMEOUT
      While Timer < t
        DoEvents
      Wend
    Next
  End With
  
  
Selection.Cells(1).Select

ошибка 1004 Run time error 1004 Application defined or object defined error

JayBhagavan Пользователь Сообщений: 11833 Регистрация: 17.01.2014 ПОЛ: МУЖСКОЙ \| Win10x64, MSO2019x64	pinguindell, не видя файла и что находится в О1 — ничем не могу помочь. <#0> Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori

	JayBhagavan,файл во вложении папку Темр нужно поместить на диск С Прикрепленные файлы Print.zip (57.3 КБ)

JayBhagavan

Пользователь

Сообщений: 11833
Регистрация: 17.01.2014

ПОЛ: МУЖСКОЙ | Win10x64, MSO2019x64

#25

07.09.2016 14:02:34

Скрытый текст

<#0>
Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori

ZVI Пользователь Сообщений: 4328 Регистрация: 23.12.2012	У JayBhagavan в сообщении #25 правильно все написано. Для порядка еще бы не помешало в начале записать: Dim lastRow as Long

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

PerfectVam

Пользователь

Сообщений: 413
Регистрация: 27.02.2017

#28

21.08.2017 11:44:37

Уважаемые модераторы!
Мне кажется, что лучше продолжить эту тему, но если сочтете более полезным открытие новой — сделаем так.

У меня тоже возникла проблема с порядком вывода на печать. Насколько я понял, очередь печати — не совсем очередь. Реализована она как стек. Из-за этого, задание, попавшее на печать раньше, но во время обработки другого, может быть обработано вообще последним!!!
Как мне привиделся выход: ожидание должно быть не фиксированным, а до тех пор, пока не закончится обработка принтером предыдущего брошенного на печать файла. Для этого нужно научиться отслеживать состояние принтера, либо наличие очереди печати.

Попытавшись сделать это самостоятельно, нашел некий код для 32-разрядной системы. Попытался исправить под 64-рязрядную. То ли криво модернизировал, то ли код вообще неподходящий, но попытка запуска вообще снесла EXCEL. Вот что у меня получилось:

Код

    Option Explicit
    Public Const STNDRD_RIGHTS_RQRD = &HF0000
    Public Const PRNTR_ACCSS_ADMIN = &H4
    Public Const PRNTR_ACCSS_USE = &H8
    Public Const PRNTR_ALL_ACCSS = STNDRD_RIGHTS_RQRD Or PRNTR_ACCSS_ADMIN Or PRNTR_ACCSS_USE
    Public Const PRNTR_CNTRL_PAUSE = 1
    Public Const PRNTR_CNTRL_RESUME = 2
    Public Const PRNTR_CNTRL_PURGE = 3
    Public Const NULL_PTR = 0&
    Public Type PRNTR_DFLTS 'pdf
        DataType As Long
        DevMode As Long
        DsrdAccess As Long
    End Type
    Public Declare PtrSafe Function OpenPrinter1 Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRNTR_DFLTS) As LongPtr
    Public Declare PtrSafe Function SetPrinter Lib "winspool.drv" Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal Command As Long) As LongPtr
    Public Declare PtrSafe Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As LongPtr
    Public Enum ePrinterControl 'epc
        PrntrCntrlPause = PRNTR_CNTRL_PAUSE
        PrinterControlPurge = PRNTR_CNTRL_PURGE
        PrinterControlResume = PRNTR_CNTRL_RESUME
    End Enum
    Public Function SetPrntrStts(ByVal pstrPrntrName As String, ByVal pepcPrntrCntrl As ePrinterControl) As Boolean
        
        Dim pdfMyDflts As PRNTR_DFLTS
        Dim lngPrntrHandle As Long
        Dim lngReturn As Variant
        Dim blnReturn As Boolean
            
        pdfMyDflts.DsrdAccess = PRNTR_ALL_ACCSS
        lngReturn = OpenPrinter1(pstrPrntrName, lngPrntrHandle, pdfMyDflts)
        blnReturn = lngReturn = 0 Or lngPrntrHandle = 0 '  Не смог открыть принтер если blnReturn=False
        
        If blnReturn Then
            blnReturn = SetPrinter(lngPrntrHandle, NULL_PTR, ByVal NULL_PTR, pepcPrntrCntrl) <> 0  'Выставить статус принтера
        End If
        If blnReturn Then
            If Not lngPrntrHandle = 0 Then
                ClosePrinter lngPrntrHandle
            End If
        End If
        
        SetPrntrStts = blnReturn
        
    End Function

Sub otl()
    MsgBox SetPrntrStts("HP LaserJet 400 M401 PCL 6 (Ne07:)", PRNTR_CNTRL_PAUSE)
End Sub

Мне, конечно, интересно самому доковырять, но вопрос времени сейчас стоит остренько.

Буду благодарен как за комментарии: «Что Ади сделал неправильно», так и за любые подсказки/намеки/готовые решения проблемы отслеживания состояния принтера, позволяющие организовать «зрячее» ожидание запуска в печать следующего файла.

Следствие из третьего закона Чизхолма:
«Даже если ясность изложения исключает неверное толкование, все равно найдется кто-то, кто поймет Вас неправильно.»

PerfectVam

Пользователь

Сообщений: 413
Регистрация: 27.02.2017

#29

22.08.2017 19:53:03

Ну вот, удалось обойтись обходным маневром без огорода API. Хоть и видел я советы, что бояться этого зверья не стоит, но не освоил еще…
В Windows, оказывается, есть папочка, в которой во время печати «рождаются» некие файлики. На моем компе это «C:WindowsSystem32spoolPRINTERS». Эксперимент показал, что при отправке на сетевой принтер с другого компа, в папочке моего компьютера ничего не рождается. Так что, мониторя наличие файлов в этой папочке, можно отслеживать исполнение именно своих заданий на печать. Чтобы пользоваться моей реализацией, до ее запуска нужно поддерживать в ней чистоту (так как проверяется рождение и последующее исчезновение любого файла в этой папке).

Я сделал печать содержимого столбца C. Легко переделать под любое другое расположение данных.
Если файлы указаны без пути, код «приделывает» к содержимому столбца «С» значение из «A1». Если в конце «A1» нет «», программа добавит его сама.
В коде программы можно выставить константу — лимит времени в секундах, чтобы, в случае его превышения для одного задания, программа прерывалась. Я установил 5 минут (300 секунд). Желающие могут вынести это куда-нибудь на лист со считыванием оттуда.

Код

Sub Печать()
Const vTimeout As Double = 300 ' время в секундах, после которого считаем, что процесс печати не удался и следует прервать программу
Const vPrin As String = "C:WindowsSystem32spoolPRINTERS" '  папка, где очередь печати отслеживается наличием файлов
Dim pApka As String
Dim i As Long, d As Single, t As Single
Dim tMp As Variant
Dim fLg As Boolean

    
  If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub
  If ActiveSheet.Name <> "Печ" Then Exit Sub
  
  pApka = ActiveSheet.Range("A1").Value
  If Right(pApka, 1) <> "" Then pApka = pApka & ""
  Columns("D:D").ClearContents
  i = 1
  With CreateObject("Shell.Application")
    Do While Len(Cells(i, 3).Value)
      tMp = Cells(i, 3).Value
      If (Len(Dir(tMp)) = 0) Then Cells(i, 4).Value = "Файл не найден": GoTo NxtCCL
      If (InStr(1, tMp, "") = 0) Then tMp = pApka & tMp
      ' Ждать очищения очереди печати.
      d = Date
      t = Timer + vTimeout
      Do
        DoEvents
        If (Len(Dir(vPrin & "*.*")) = 0) Then Exit Do
        If ((Date - d) * 86400 + Timer) > t Then ActiveSheet.Cells(i, 4).Value = "Прерван по истечении заданного времени ожидания": Exit Sub
      Loop
      ' Сменить выделение, чтобы было видно обрабатываемый файл.
      Cells(i, 3).Select
      ' Печатать
      .ShellExecute tMp, "", "", "print", 0&
      ' Подождать окончания печати отправленного задания
      d = Date
      t = Timer + vTimeout
      fLg = False
      Do
        DoEvents
        If Len(Dir(vPrin & "*.*")) Then fLg = True
        If fLg And (Len(Dir(vPrin & "*.*")) = 0) Then ActiveSheet.Cells(i, 4).Value = "Принтер принял": Exit Do
        If ((Date - d) * 86400 + Timer) > t Then ActiveSheet.Cells(i, 4).Value = "Прерван по истечении заданного времени ожидания": Exit Sub
      Loop
NxtCCL:
      i = i + 1
    Loop
  End With
 
End Sub

«Заплатка», конечно, но в умелых руках проблему решает…

Прикрепленные файлы

ПечатьPDF.xlsm (23.07 КБ)

ZVI

Пользователь

Сообщений: 4328
Регистрация: 23.12.2012

#30

22.08.2017 21:52:12

Цитата
PerfectVam: ПечатьPDF.xlsm

Если установлена профессиональная версия Acrobat, и такой тест не вызывает ошибки:

Код
Sub Test() With CreateObject("AcroExch.App"): End With With CreateObject("AcroExch.AVDoc"): End With End Sub

или, что в принципе одно и тоже, установлена ссылка: VBE — Tools — Refereces — ‘Acrobat’ или ‘Adobe Acrobat ##.# Type Library’ (XX.X — номер версии) — OK,
то распечатать файлы PDF или их заданные страницы можно, используя метод AVDoc.PrintPagesSilent.
У меня, например, в XP устанавливалась такая ссылка (reference) на библиотеку Acrobat XI Professional: «C:Program FilesAdobeAcrobat 11.0Acrobatacrobat.tlb»
Принцип распечатки:

Код

Sub PrintPDF()
  Const f = "C:TempTest.PDF"
  With CreateObject("AcroExch.App")
    With CreateObject("AcroExch.AVDoc")
      .Open f, vbNullString
      .PrintPagesSilent 0, .GetPDDoc.GetNumPages - 1, 0, False, True
    End With
    .CloseAllDocs
    .Exit
  End With
End Sub

Приведенный выше код распечатает документ PDF аналогично тому, как это может быть сделано из интерфейса Adobe. А проблема спуллинга и очередности распечатки на сетевом принтере — это действительно отдельная задача.

Изменено: ZVI — 22.08.2017 22:22:17

Источник

Since Excel 2010, it has been possible to save Excel as PDF. The PDF format was then and continues to be, one of the most common file formats for distributing documents.

The code examples below provide the VBA macros to automate the creation of PDFs from Excel using the ExportAsFixedFormat method. This means you do not require a PDF printer installed, as Excel can print directly to a PDF document.

The example codes can be used independently or as part of a larger automation process. For example, check out this post to see an example of how to loop through a list and print a PDF for each item: Create multiple PDFs based on a list

Rather than going from Excel to PDF, you might want to go the other way; from PDF to Excel. Check out these posts for possible solutions for that scenario:

How to Import PDF Files into Excel with Power Query
Get data from PDF into Excel

Download the example file: Click the link below to download the example file used for this post:

Saving Excel workbooks, sheets, charts, and ranges as PDF
- Save active sheet as PDF
- Save active workbook as PDF
- Save selection as PDF
- Save a range as PDF
- Save a chart as PDF
- Adapting the code to your scenario
- Notes for saving PDF documents
Selecting specific worksheets before saving as PDF
Looping and saving as separate PDFs
- Loop through sheets
- Loop through selected sheets
- Loop through charts
Other PDF print options
- VBA Save to PDF Example using all the options
Other fixed formats available (xlTypeXPS)
Conclusion

Saving Excel workbooks, sheets, charts, and ranges as PDF

This section contains the base code to save Excel as PDF from different objects (workbooks, worksheets, ranges, and charts). From a VBA perspective, it is the ExportAsFilxedFormat method combined with the Type property set to xlTypePDF that creates a PDF.

Save active sheet as PDF

The following code saves the selected sheets as a single PDF.

Sub SaveActiveSheetsAsPDF()

'Create and assign variables
Dim saveLocation As String
saveLocation = "C:UsersmarksOneDriveDocumentsmyPDFFile.pdf"

'Save Active Sheet(s) as PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation

End Sub

Save active workbook as PDF

Use the following macro to save all the visible sheets from a workbook.

Sub SaveActiveWorkbookAsPDF()

'Create and assign variables
Dim saveLocation As String
saveLocation = "C:UsersmarksOneDriveDocumentsmyPDFFile.pdf"

'Save active workbook as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation

End Sub

Save selection as PDF

Sometimes, we only want to save a small part of a worksheet to a PDF. The following code prints only the selected cells.

Sub SaveSelectionAsPDF()

'Create and assign variables
Dim saveLocation As String
saveLocation = "C:UsersmarksOneDriveDocumentsmyPDFFile.pdf"

'Save selection as PDF
Selection.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation

End Sub

Save a range as PDF

The macro below saves a specified range as a PDF.

Sub SaveRangeAsPDF()

'Create and assign variables
Dim saveLocation As String
Dim ws as Worksheet
Dim rng As Range

saveLocation = "C:UsersmarksOneDriveDocumentsmyPDFFile.pdf"
Set ws = Sheets("Sheet1")
Set rng = ws.Range("A1:H20")

'Save a range as PDF
rng.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation

End Sub

Save a chart as PDF

The VBA code below saves a specified chart as a PDF.

Sub SaveChartAsPDF()

'Create and assign variables
Dim saveLocation As String
Dim ws As Worksheet
Dim cht As Chart

saveLocation = "C:UsersmarksOneDriveDocumentsmyPDFFile.pdf"
Set ws = Sheets("Sheet1")
Set cht = ws.ChartObjects("Chart 1").Chart

'Save a chart as PDF
cht.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation

End Sub

Rather than naming a specific chart, the macro could run based on the active chart. Change this:

Set cht = ws.ChartObjects("Chart 1").Chart

To this:

Set cht = ActiveChart

Adapting the code to your scenario

To adapt the code examples to your specific needs, you should adjust certain lines of code.

Change the save location

To save the file in the correct location, change this list of code:

saveLocation = "C:UsersmarksOneDriveDocumentsmyPDFFile.pdf"

If you would prefer the save location to be included in a cell, change the code to reference the sheet and cell containing the file path.

saveLocation = Sheets("Sheet1").Range("B2").Value

Change the worksheet

In this line of code, change the text “Sheet1” to the sheet name in your workbook.

Set ws = Sheets("Sheet1")

Change the range

The following line of codes references the range to be printed to PDF.

Set rng = ws.Range("A1:H20")

Change the chart

To print a chart to PDF, change the chart’s name in the following line of code.

Set cht = ws.ChartObjects("Chart 1").Chart

If you are unsure of the chart name, it is shown in the Name box when the chart is selected.

Notes for saving PDF documents

While the Filename property is optional, it is important to know where the file is saved.

If the Filename property is not provided, the PDF saves in your default folder location using the Excel workbook’s name with the .pdf file extension.
Where a file name is provided, but not a file path, the document saves in your default folder location with the name provided.
When the .pdf file extension is not provided, the suffix is added automatically.
If a PDF exists in the specified save location, the existing file is overwritten. Therefore, it may be necessary to include file handling procedures to prevent overwriting existing documents and handling errors.
To save as an XPS document format, change xlTypePDF for xlTypeXPS.

Selecting specific worksheets before saving as PDF

If more than one worksheet is active, the PDF created includes all the active sheets. The following code selects multiple worksheets from an array before saving the PDF.

Sub SelectSheetsAndSaveAsPDF()

'Create and assign variables
Dim saveLocation As String
Dim sheetArray As Variant

saveLocation = "C:UsersmarksOneDriveDocumentsmyPDFFile.pdf"
sheetArray = Array("Sheet1", "Sheet2")

'Select specific sheets from workbook, the save all as PDF
Sheets(sheetArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=saveLocation

End Sub

In the code above, an array is used to select the specific sheets. Alternatively, the Split array function with a text string could provide a more dynamic solution. This method is covered here: VBA Arrays.

Looping and saving as separate PDFs

To save multiple PDFs quickly, we can use VBA to loop through sheets or charts and save each individually.

Loop through sheets

The following macro loops through each worksheet in the active workbook and saves each as its own PDF. Each PDF is saved in the same folder as the workbook, where each PDF’s name is based on the worksheet’s name.

Sub LoopSheetsSaveAsPDF()

'Create variables
Dim ws As Worksheet

'Loop through all worksheets and save as individual PDF in same folder
'as the Excel file
For Each ws In ActiveWorkbook.Worksheets

    ws.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "/" & ws.Name & ".pdf"

Next

End Sub

Loop through selected sheets

The following macro loops through only the selected worksheets in the active workbook and saves each as its own PDF.

Sub LoopSelectedSheetsSaveAsPDF()

'Create variables
Dim ws As Worksheet
Dim sheetArray As Variant

'Capture the selected sheets
Set sheetArray = ActiveWindow.SelectedSheets

'Loop through each selected worksheet
For Each ws In sheetArray

    ws.Select

    ws.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "/" & ws.Name & ".pdf"

Next ws

'Reselect the selected sheets
sheetArray.Select

End Sub

Loop through charts

The following code loops through each chart on the active sheet and saves each as a separate PDF.

Sub LoopChartsSaveAsPDF()

'Create and assign variables
Dim chtObj As ChartObject
Dim ws As Worksheet

Set ws = ActiveSheet

'Loop through all charts and save as individual PDF in same folder
'as the Excel file
For Each chtObj In ws.ChartObjects

    chtObj.Chart.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "/" & chtObj.Name & ".pdf"

Next chtObj

End Sub

Other PDF print options

When using ExportAsFixedFormat, there are other optional settings available:

'Open the document after it is saved - options are True / False
OpenAfterPublish:=False

'Include the Excel document properties into the PDF - options are True / False
IncludeDocProperties:=True

'Does the created PDF adhere to the Print Areas already set in the 
'worksheet - options are True / False
IgnorePrintAreas:=False

'Set the output quality of the created document - options are 
'xlQualityMinimum / xlQualityStandard
Quality:=xlQualityStandard

'The page to start printing. If excluded, will start from the first page
From:=1

'The page to print to. If excluded, will go to the last page
To:=2

VBA Save to PDF Example using all the options

The code below demonstrates how to use all the options within a single macro. These options can be flexed to meet your requirements.

Sub SaveAsPDFOptions()

Dim saveLocation As String
saveLocation = "C:UsersmarksDocumentsmyPDFFile.pdf"

'Example using all the options
ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=saveLocation, _
    OpenAfterPublish:=False, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    Quality:=xlQualityStandard, _
    From:=1, To:=2

End Sub

Other fixed formats available (xlTypeXPS)

The Type property can also create XPS documents when it is set to xlTypeXPS rather than xlTypePDF. XPS is Microsoft’s fixed file format; it is similar to PDF but based on the XML language. It is rarely used in the real world but is an option if required.

Conclusion

Learning how to save Excel as PDF is a good time investment. Each of these code snippets on its own is useful. However, the code examples above can be used in other automation to create even more time-saving.

Excel – Create multiple PDFs based on a list
Loop through selected sheets with VBA
How to loop through each item in Data Validation list with VBA

About the author

Hey, I’m Mark, and I run Excel Off The Grid.

My parents tell me that at the age of 7 I declared I was going to become a qualified accountant. I was either psychic or had no imagination, as that is exactly what happened. However, it wasn’t until I was 35 that my journey really began.

In 2015, I started a new job, for which I was regularly working after 10pm. As a result, I rarely saw my children during the week. So, I started searching for the secrets to automating Excel. I discovered that by building a small number of simple tools, I could combine them together in different ways to automate nearly all my regular tasks. This meant I could work less hours (and I got pay raises!). Today, I teach these techniques to other professionals in our training program so they too can spend less time at work (and more time with their children and doing the things they love).

Do you need help adapting this post to your needs?

I’m guessing the examples in this post don’t exactly match your situation. We all use Excel differently, so it’s impossible to write a post that will meet everybody’s needs. By taking the time to understand the techniques and principles in this post (and elsewhere on this site), you should be able to adapt it to your needs.

But, if you’re still struggling you should:

Read other blogs, or watch YouTube videos on the same topic. You will benefit much more by discovering your own solutions.
Ask the ‘Excel Ninja’ in your office. It’s amazing what things other people know.
Ask a question in a forum like Mr Excel, or the Microsoft Answers Community. Remember, the people on these forums are generally giving their time for free. So take care to craft your question, make sure it’s clear and concise. List all the things you’ve tried, and provide screenshots, code segments and example workbooks.
Use Excel Rescue, who are my consultancy partner. They help by providing solutions to smaller Excel problems.

What next?
Don’t go yet, there is plenty more to learn on Excel Off The Grid. Check out the latest posts:

Источник

I have wrote a code to print excel file to .PDF file with the page setups parameters.And also it eliminates the need of having a prompt dialog box also.

But I need to know if I need to name the .PDF file as same as the excel file name with below code but not the same destination path.As an example:= if excel file name is «Quality Report 1411185623689» This file is generated by a system therefore its name is changed everyday.
How do I solve this?

 Sub Save_As_PDF()
With ActiveSheet.PageSetup
     .Orientation=xlLandscape
     .Zoom=16

End With
ActiveSheet.ExportAsFixedFormat _
 Type:=xlTypePDF, _
 FileName:="C:DesktopReportsSame as excel file name", _
 Quality:=xlQualityStandard, _
 IncludeDocProperties:=False, _
 IgnorePrintAreas:=False, _
 OpenAfterPublish:=True

Exit Sub

0m3r

12.2k15 gold badges33 silver badges70 bronze badges

asked Nov 14, 2018 at 3:53

Untested, but assuming you want to name the PDF the same as the Excel file (ignoring file extension), but in a different folder (say some folder/directory called "C:DesktopReports" for example):

Option explicit

Sub SaveAsPDF()

Dim folderPath as string
folderPath = "C:DesktopReports" ' Change to whatever folder, but make sure it ends with a 

If len(dir$(folderPath, vbDirectory)) = 0 then
Msgbox("'" & folderPath & "' is not a valid/existing directory. Abandoning export. Code will stop running now.")
Exit sub
End if

Dim Filename as string
Filename = left$(Thisworkbook.name, instrrev(Thisworkbook.name, ".", -1, vbbinarycompare) -1) & ".pdf"

With ActiveSheet.PageSetup
     .Orientation=xlLandscape
     .Zoom=16
End With
ActiveSheet.ExportAsFixedFormat _
 Type:=xlTypePDF, _
 FileName:=folderPath & filename, _
 Quality:=xlQualityStandard, _
 IncludeDocProperties:=False, _
 IgnorePrintAreas:=False, _
 OpenAfterPublish:=True

Exit Sub

answered Nov 14, 2018 at 4:18

chillinchillin

4,3511 gold badge8 silver badges8 bronze badges

Источник