'==========================================================================================

'##### Экспорт нескольких листов в PDF

'

'------------------------------------------------------------------------------------------

Sub test_Экспорт_в_PDF()

Windows(ThisWorkbook.Name).Activate

strArShNames = "..., ..., ..., ..."

Call Export_PDF("", strArShNames, "Имя для сохраняемого файла")

End Sub

Sub Export_PDF(ByVal strChDir As String, _

ByVal strArShNames As String, _

ByVal strSaveName As String)

Dim dDate As Date: dDate = Now

Dim dTime As Date: dTime = Format(dDate, "hh:mm:ss") '"06:00:00" '

Dim strDate As String

Dim m As Variant

Dim strActivShName As String: strActivShName = ActiveSheet.Name

Windows(ThisWorkbook.Name).Activate

If dTime < "12:00:00" Then

dDate = Format(Now - 1, "DD.MM.YYYY") '& " 07:00:00"

Else

dDate = Format(Now, "DD.MM.YYYY") '& " 07:00:00"

End If

vValue = InputBox("Оставьте поле пустым для текущей даты", "Введите дату", dDate, 2000, 2000)

If Len(Trim(vValue)) > 0 Then

strDate = Format(Trim(vValue), "YYYY-MM-DD")

On Error Resume Next

' strChDir = "<path_to_folder_or_file>"

If Len(Trim(strChDir)) = 0 Then strChDir = ThisWorkbook.Path & "\"

strFileName = strDate & "_" & strSaveName & ".pdf"

Kill strChDir & strFileName 'удалить предыдущий файл

Sheets(Split(strArShNames, ", ", -1, vbTextCompare)).Select 'выделить листы

'сохранение в PDF

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _

strChDir & strFileName, _

Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

:=False, OpenAfterPublish:=True

End If

Sheets(strActivShName).Activate 'вернуться в исходный лист

End Sub

'==========================================================================================