将Excel中的多个图表保存为一个PDF文件

将Excel中的多个图表保存为一个PDF文件

问题描述:

我正在使用Excel 2013.我试图将一个Excel工作簿中的多个图表保存为pdf文件。这些图表位于不同的有数据的工作表上。所以,我需要选择每张纸上的图表并保存到一个PDF文件。我想在pdf文件的一页上绘制一张图表。有没有办法做到这一点?我感谢支持。将Excel中的多个图表保存为一个PDF文件

谢谢Jeannine

选择带有图表的纸张并保存为PDF。

一个VBA解决方案,反射看起来有点麻烦,但它是可定制的?将代码放入标准代码模块中,并将outputPath替换为您的代码。该方法是在单独的工作表上组成布局,然后将工作表导出到.pdf。对于这个例子,确保你的工作簿中有一个名为“Compose”的工作表(可能需要添加一些代码来完成此工作)。

Option Explicit 

Sub chartsTopdf() 
Dim outSheet As Worksheet, sht As Worksheet 
Dim RngToCover As Range 
Dim chtObj As ChartObject 
Dim outputPath As String, fileStem As String 
Dim chHeight As Long, chWidth As Long 
Dim topM As Integer, botM As Integer, rightM As Integer 
Dim n As Integer, pbRow As Integer, rwOffset As Integer 
Dim chrt As String 

Set outSheet = Sheets("Compose") 
outputPath = "C:\Data\Barry\VBA\SO\" 
fileStem = "Charts" 
'these values in 'points' 
topM = 60 
botM = 60 
rightM = 60 
'these values in 'rows' 
pbRow = 1 
rwOffset = 8 
chHeight = 12 
chWidth = 5 
Set RngToCover = Cells(chHeight, chWidth) 
n = 0 

    With ThisWorkbook 
     With outSheet 
      .ResetAllPageBreaks 
      .ChartObjects.Delete 
       With .PageSetup 
        .Orientation = xlPortrait 
        .PrintArea = "" 
        .TopMargin = topM 
        .BottomMargin = botM 
        .RightMargin = rightM 
       End With 
     End With 

     For Each sht In .Worksheets 
      If Not sht.Name = outSheet.Name Then 
       'Copy Chart 
       Set chtObj = sht.ChartObjects(1) 
       chtObj.Copy 
        With outSheet 
         .Paste 
         n = n + 1 
         Set RngToCover = .Range(.Cells(pbRow + rwOffset, 1), .Cells(pbRow + rwOffset + chHeight, 1 + chWidth)) 
         Set chtObj = .ChartObjects(n) 
         chtObj.Height = RngToCover.Height ' resize 
         chtObj.Width = RngToCover.Width ' resize 
         chtObj.Top = RngToCover.Top  ' reposition 
         chtObj.Left = RngToCover.Left  ' reposition 
         'add hpage break 
         .HPageBreaks.Add before:=.Cells(pbRow + rwOffset + chHeight, 1 + chWidth).Offset(2, 0) 

         pbRow = .HPageBreaks(n).Location.Row 
        End With 
      End If 
     Next sht 

    ActiveCell.Select 

     'set essential page parameters 
     With outSheet.PageSetup 
      .Orientation = xlPortrait 
      .PrintArea = "" 
      .TopMargin = topM 
      .BottomMargin = botM 
      .RightMargin = rightM 
     End With 

     'produce pdf file 
     outSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
      outputPath & fileStem & ".pdf", Quality:=xlQualityStandard, _ 
      IncludeDocProperties:=True, IgnorePrintAreas:=False, _ 
      OpenAfterPublish:=True 

    End With 

End Sub 

我使用Jon Peltier的interesting article,这也许是有趣的。

+0

非常感谢! – Jeannine 2014-11-24 04:02:41

+0

如果它回答你的Q,也许你会'接受'答案,点击'嘀嗒'。这将表明它已经解决。 – barryleajo 2014-11-24 06:50:55