vbscript 使用文件对话框将工作簿导出为PDF

Posted 2021-05-21

Sub PDFWorkbook()
    Dim strSheets() As String
    Dim strfile As String
    Dim sh As Worksheet
    Dim icount As Integer
    Dim myfile As Variant
    Dim startingPage As Integer
    
    ' Save Chart Sheet names to an Array
    For Each sh In ActiveWorkbook.Worksheets
    If sh.Visible = xlSheetVisible Then
        ReDim Preserve strSheets(icount)
        strSheets(icount) = sh.Name
        icount = icount + 1
    End If
    
    Next sh
    
    If icount = 0 Then
        MsgBox "A PDF cannot be created because no sheets were found.", , "No Sheets Found"
        Exit Sub
    End If
    
    ' Prompt for save location
    strfile = "Sheets" & "_" _
    & Format(Now(), "yyyymmdd_hhmmss") _
    & ".pdf"
    strfile = ThisWorkbook.path & "\" & strfile
    myfile = Application.GetSaveAsFilename _
    (InitialFileName:=strfile, _
    FileFilter:="PDF Files (*.pdf), *.pdf", _
    Title:="Select Folder and File Name to Save as PDF")
    
    If myfile <> "False" Then 'save as PDF
        
        ActiveWorkbook.ExportAsFixedFormat xlTypePDF, myfile & ".pdf", _
                                       xlQualityStandard, , , , , True
        
    Else
        MsgBox "No File Selected. PDF will not be saved", vbInformation, "No File Selected"
    End If
End Sub