我使用以下例程将图表导出(保存)为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作为示例如下:
pdf有相当大的余量,我想减少或删除它。我试图改变IgnorePrintArea
属性和IncludeDocProperties
属性,但似乎没有任何影响。
有没有办法减少.ExportAsFixedFileFormat
的利润?
编辑:我被要求提供图表在excel中的外观截图:
您可以尝试指定要导出的区域。如果.pdf
内容已减少,这将有效。例如,假设您的图表与单元格A1
对齐H30
。你可以导出:
source.Sheets(Curves(i)).Range("A1:H30").ExportAsFixedFormat Type:=xlTypePDF...
请记住,您可以列出您的范围以适合您自己的代码。
通过这样做,您可以避免文档顶部的额外红线。
可能是我没有清楚地理解这个问题。如果你只想减少保证金,那么对于赏金问题来说似乎太简单了(只需将利润率降低到0或PageSetup
所需)。结果可能像这个
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
下面的代码对我有用。我留下了一些可能对你有用的注释行。我不确定需要ch.Activate
。我希望它不是,但我没有彻底测试。
我获得的图像也在下面。我不知道这对你来说是不是太大了,但它似乎比你的情况要少。
' 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