2017-11-11 123 views
1

我希望將多於2個Excel工作表保存爲一個PDF文件。我有這個代碼,但它只能保存單個文件,如何使其工作,以便它可以選擇2個文件並將其保存爲單個PDF。將多個Excel表保存爲一個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 
+0

如果手工做的,我們選擇兩個表,則僅保存爲PDF格式,爲您的代碼,你可以做同樣的 – Rosetta

+0

感謝您的建議,我捕捉到代碼中使用宏,並添加表在數組名和它的工作.Sheets(數組(「設計」,「數據」))。選擇 – Hola

回答

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 
1

選擇多張後,導出Activesheet。

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