MyTetra Share
Делитесь знаниями!
Экспорт нескольких листов в PDF
Время создания: 16.03.2019 23:43
Текстовые метки: VBA, PDF, Export_PDF
Раздел: !Закладки - VBA - Excel - Листы


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

'##### Экспорт нескольких листов в 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

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


Так же в этом разделе:
 
MyTetra Share v.0.53
Яндекс индекс цитирования