Question

我希望将超过2个excel工作表保存为单个PDF文件。我有这个代码，但它只能保存单个文件，如何使它工作，以便它可以选择2个文件并将其保存为单个PDF。

Sub CMSaveAsPDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant

On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = Worksheets("Design")
strPath = wbA.path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

strFile = "Design" 
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
    FileFilter:="PDF Files (*.pdf), *.pdf", _
    Title:="Select Folder and FileName to save")

      If myFile <> "False" Then
      wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If
End sub

Answer 1

Sub CMSaveAsPDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant

On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = Worksheets("Design")
strPath = wbA.path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

strFile = "Design" 
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
    FileFilter:="PDF Files (*.pdf), *.pdf", _
    Title:="Select Folder and FileName to save")

     If myFile <> "False" Then
     Sheets(Array("Design", "Data")).Select  ' Selected sheet names in array
      wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If
End sub

Answer 2

选择多张纸后，导出活动表。

Sub CMSaveAsPDF()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant

On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = Worksheets("Design")
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

strFile = "Design"
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
    FileFilter:="PDF Files (*.pdf), *.pdf", _
    Title:="Select Folder and FileName to save")

      If myFile <> "False" Then
      Sheets(Array("Design", "Data")).Select 'first multi sheets select
      'change to Activesheet
      ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If
End Sub

将1个以上的Excel工作表保存为单个PDF

2 个答案: