问题
I use the following routine to export (save) a chartsheet as pdf. The function gets the names of the user selected chartsheets in a collection. Then it exports one by one as a pdf where the user can select the save folder of the exported pdf. Here my code.
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
The code works as expected and prints out the pdfs as an example below:
The pdf has quite the margin though and I want to reduce or remove it. I have tried to change the IgnorePrintArea property and the IncludeDocProperties property but nothing seems to have an effect on the margin.
Is there a way to reduce the margin with the .ExportAsFixedFileFormat ?
EDIT: I was asked to provide a screenshot of how the chart looks in excel:
回答1:
You could try and specify a bit more the area to export. This will work if the .pdf content has been reduced. For instance, lets say your chart is align with the cells A1 to H30. You could export:
source.Sheets(Curves(i)).Range("A1:H30").ExportAsFixedFormat Type:=xlTypePDF...
Remember you could list your ranges to fit this in your own code.
By doing this, you can avoid the extra red line on the top of your document.
回答2:
May be I failed to understand the question clearly. If you only want to reduce margin, then it seems too simple for a bounty question (just reduce margins to 0 or required in PageSetup). result may be like this
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
回答3:
The code below worked for me.
I left some commented lines which might be useful for you.
I am not sure ch.Activate is needed. I would expect it is not, but I did not test it thoroughly.
The image I obtained is below as well. I don't know if that is too much of a margin for you, but it seems to have less white margin than your case.
' 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
回答4:
Solution using Word as a helper application
As far as I know, there is no way by just using .ExportAsFixedFileFormat but what you desire is possible using Word as a helper application, as I will demonstrate in the following code.
To make exporting a bunch of charts not constantly open and close Word I implemented a ShapeExporter Class, that holds an instance of Word and uses it for exporting the charts or shapes:
Usage in a normal module, if the charge is an embedded chart (chart in a worksheet)
Sub ExportChartToPDF()
' Setting up the variables for passing to ShapeExporter
Dim MyChart As Object
' If your chart is an embedded chart in a worksheet
Set MyChart = ThisWorkbook.Worksheets("YourWorksheet").ChartObjects("ChartName")
' If your chart is it's own "chart sheet" like in os's question:
Set MyChart = ThisWorkbook.Charts("ChartSheetName").ChartArea
Dim fileName As String
fileName = "TestExport"
Dim filePath As String
filePath = ThisWorkbook.Path
' Creating an instance of our ShapeExporter:
' During the creation of the object, Word is opened in the background
' if it wasn't already open.
Dim oShapeExporter As cShapeExporter
Set oShapeExporter = New cShapeExporter
' Export as many shapes as you want here, before destroying oShapeExporter
' The ExportShapeAsPDF method pastes the chart in a word document, resizes the
' Document to be exactly the size of the chart and then saves it as PDF
oShapeExporter.ExportShapeAsPDF MyChart, fileName, filePath
' As the object goes out of scope, the background instance of Word
' gets closed, if it wasn't open at the time of the creation of the object
Set oShapeExporter = Nothing
End Sub
To use the exporter object you have to paste the following code to a class module and name the class module cShapeExporter:
Option Explicit
' Storing the instance of Word in the object
Dim wdApp As Object
Dim wdDoc As Object
Dim wdWasOpen As Boolean
Private Sub Class_Initialize()
' Opening Word
If WordIsRunning Then
Set wdApp = GetObject(, "Word.Application")
wdWasOpen = True
Else
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
wdWasOpen = False
End If
' And creating a Document that will be used for the pasting and exporting
Set wdDoc = wdApp.Documents.Add
' Setting margins to 0 so we have no white borders!
' If you want, you can set custom white borders for the exported PDF here
With wdDoc.PageSetup
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 0
End With
End Sub
Private Sub Class_Terminate()
' Important: Close Word as the object is destroyed, but only if it wasn't
' previously opened!
If Not wdWasOpen Then
wdApp.Quit 0 '(wdDoNotSaveChanges)
Else
wdDoc.Close 0
End If
Set wdApp = Nothing
Set wdDoc = Nothing
End Sub
Public Sub ExportShapeAsPDF(xlShp As Object, fileName As String, filePath As String)
' Defining which objects can be exported, maybe others are also supported,
' they just need to support all the methods and have all the properties used
' in this sub
If TypeName(xlShp) = "ChartObject" Or TypeName(xlShp) = "Shape" Or TypeName(xlShp) = "ChartArea" Then
'fine
Else
MsgBox "Exporting Objects of type " & TypeName(xlShp) & " not supported, sorry."
Exit Sub
End If
' Copying the Excel object into the Word Document
xlShp.Copy
wdDoc.Range.Paste
Dim wdShp As Object
Set wdShp = wdDoc.Shapes(1)
' Resizing the Word Document
With wdDoc.PageSetup
.PageWidth = wdShp.Width
.PageHeight = wdShp.Height
End With
' Aligning the pasted object
wdShp.Top = 0
wdShp.Left = 0
' Export as .pdf
wdDoc.saveas2 fileName:=filePath & "\" & fileName, FileFormat:=17 '(wdExportFormatPDF)
' Delete shape in wdDoc
wdShp.Delete
End Sub
' Utility Function
Private Function WordIsRunning() As Boolean
Dim wdApp As Object
On Error Resume Next
Err.Clear
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
WordIsRunning = False
Else
WordIsRunning = True
End If
End Function
来源：https://stackoverflow.com/questions/53886601/print-chartsheet-without-margin-from-excel-using-vbas-exportasfixedformat-meth