2017-11-11 178 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