使用vba的.ExportAsFixedFormat方法打印没有excel边距的图表表?

问题描述 投票:4回答:3

我使用以下例程将图表导出(保存)为pdf。该函数获取集合中用户选择的图表的名称。然后它逐个导出为pdf,用户可以在其中选择导出的pdf的保存文件夹。在这里我的代码。

Private Function ExportCurvesPDF(Curves As Collection)
Dim source As Workbook
Dim i As Integer
Dim FileName As String
Dim ExportPath As String

Set source = Thisworkbook

ExportPath = "V:\"
For i = 1 To Curves.count
    FileName = Application.GetSaveAsFilename(ExportPath & Curves(i) & ".pdf")

    If FileName <> "False" Then
       source.Sheets(Curves(i)).ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    End If

    ExportPath = common_DB.FolderFromPath(FileName)
Next i

End Function

代码按预期工作并打印出pdf作为示例如下:

This is how it looks in PDF

pdf有相当大的余量,我想减少或删除它。我试图改变IgnorePrintArea属性和IncludeDocProperties属性,但似乎没有任何影响。

有没有办法减少.ExportAsFixedFileFormat的利润?

编辑:我被要求提供图表在excel中的外观截图:

This is how it looks in excel

excel vba export-to-pdf
3个回答
0
投票

您可以尝试指定要导出的区域。如果.pdf内容已减少,这将有效。例如,假设您的图表与单元格A1对齐H30。你可以导出:

source.Sheets(Curves(i)).Range("A1:H30").ExportAsFixedFormat Type:=xlTypePDF...

请记住,您可以列出您的范围以适合您自己的代码。

通过这样做,您可以避免文档顶部的额外红线。


0
投票

可能是我没有清楚地理解这个问题。如果你只想减少保证金,那么对于赏金问题来说似乎太简单了(只需将利润率降低到0或PageSetup所需)。结果可能像这个enter image description here

 With source.Sheets(Curves(i)).PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
 End With

source.Sheets(Curves(i)).ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

-1
投票

下面的代码对我有用。我留下了一些可能对你有用的注释行。我不确定需要ch.Activate。我希望它不是,但我没有彻底测试。

我获得的图像也在下面。我不知道这对你来说是不是太大了,但它似乎比你的情况要少。

enter image description here

' Sub only for testing
Private Sub ExportCurvesPDF_caller()
    Dim chsheets As Sheets
    Set chsheets = Charts
    Call ExportCurvesPDF(chsheets)
End Sub

' The Subs you need
Private Sub ExportCurvesPDF(Curves As Sheets)        
    Dim ExportPath As String
    ExportPath = "C:\Users\user1\Documents\"

    Dim ch As Chart
    For Each ch In Curves
        Dim FileName As String
        FileName = ExportPath & ch.Name
        ch.Activate
        Call set_margins(ch)
        ch.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Next ch        
End Sub

Private Sub set_margins(ch As Chart)
    Application.PrintCommunication = False
    With ch.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        '.ChartSize = xlScreenSize
        '.PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        '.Orientation = xlLandscape
        .Draft = False
        .OddAndEvenPagesHeaderFooter = False
        '.DifferentFirstPageHeaderFooter = False
        '.EvenPage.LeftHeader.Text = ""
        '.EvenPage.CenterHeader.Text = ""
        '.EvenPage.RightHeader.Text = ""
        '.EvenPage.LeftFooter.Text = ""
        '.EvenPage.CenterFooter.Text = ""
        '.EvenPage.RightFooter.Text = ""
        '.FirstPage.LeftHeader.Text = ""
        '.FirstPage.CenterHeader.Text = ""
        '.FirstPage.RightHeader.Text = ""
        '.FirstPage.LeftFooter.Text = ""
        '.FirstPage.CenterFooter.Text = ""
        '.FirstPage.RightFooter.Text = ""
        .PaperSize = xlPaperA4
        '.FirstPageNumber = xlAutomatic
        '.BlackAndWhite = False
        '.Zoom = 100
    End With
    Application.PrintCommunication = True
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.