将工作簿中的每个工作表保存为单个pdf

我所拥有的是一张工作簿,其中包含“工作表”中所有销售人员的销售情况,其他表中的工作表由销售人员编号(“41”,“51”,“88”等)与他们的销售。 我想要的macros是把每个工作表,并保存为PDF“工作表名称”和“文件名”

我的问题是关于这个职位,但由于某种原因,我的版本是不保存pdf的正确。

excel vba – 将工作簿中的每个工作表保存为一个单独的pdf

所以我想要的是简单的:把每个工作表,并保存到它自己的独特的PDF。 我遇到的问题是,macros正在用正确的文件名保存每个单独的表,但是当我打开PDF时,它是每个PDF相同的销售助理。

这里是代码:

Option Explicit Sub WorksheetLoop() Dim wsA As Worksheet Dim wbA As Workbook Dim strTime As String Dim strName As String Dim strPath As String Dim strFile As String Dim strPathFile As String Dim myFile As Variant Dim WS_Count As Integer Dim I As Integer ' Set WS_Count equal to the number of worksheets in the active workbook. Set wbA = ActiveWorkbook WS_Count = wbA.Worksheets.Count strPath = wbA.Path strTime = Format(Now(), "yyyymmdd\_hhmm") 'get active workbook folder, if saved strPath = wbA.Path If strPath = "" Then strPath = Application.DefaultFilePath End If strPath = strPath & "\" ' Begin the loop. For I = 1 To WS_Count 'replace spaces and periods in sheet name strName = Replace(wbA.Worksheets(I).Name, " ", "") strName = Replace(strName, ".", "_") 'create default name for savng file strFile = strName & "_" & strTime & ".pdf" myFile = strPath & strFile Debug.Print myFile 'export to PDF if a folder was selected If myFile <> "False" Then 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 Next I End Sub 

让我知道你是否需要任何额外的细节

您需要先Activate每个工作表,然后再将其打印到pdf中。 尝试这个

  ' Begin the loop. For Each wsA In wbA.Sheets wsA.Activate 'replace spaces and periods in sheet name strName = Replace(wsA.Name, " ", "") strName = Replace(strName, ".", "_") 'create default name for savng file strFile = strName & "_" & strTime & ".pdf" myFile = strPath & strFile Debug.Print myFile 'export to PDF if a folder was selected If myFile <> "False" Then 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 Next 

在将其导出为PDF之前,您应该先激活每个工作表。 尝试:

 Option Explicit Sub WorksheetLoop() Dim wsA As Worksheet Dim wbA As Workbook Dim strTime As String Dim strName As String Dim strPath As String Dim strFile As String Dim strPathFile As String Dim myFile As Variant Dim WS_Count As Integer Dim I As Integer ' Set WS_Count equal to the number of worksheets in the active workbook. Set wbA = ActiveWorkbook WS_Count = wbA.Worksheets.Count strPath = wbA.Path strTime = Format(Now(), "yyyymmdd\_hhmm") 'get active workbook folder, if saved strPath = wbA.Path If strPath = "" Then strPath = Application.DefaultFilePath End If strPath = strPath & "\" ' Begin the loop. For Each wsA In wbA.Worksheets wsA.Activate 'replace spaces and periods in sheet name strName = Replace(wsA.Name, " ", "") strName = Replace(strName, ".", "_") 'create default name for savng file strFile = strName & "_" & strTime & ".pdf" myFile = strPath & strFile Debug.Print myFile 'export to PDF if a folder was selected If myFile <> "False" Then 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 Next wsA End Sub