Still very happy that you could help me! Can I ask you another question?
I am trying to evolve the macro so that I can save different graphs from different sheets. It seems to almost work, but somehow the graphs are not always updated before export, ik looks like somehow it saves a cached version or sometimes even another graph on a other sheet. Also, the graph gets exported as part of the page layout, so the graph is crossing the dashed page borders, it gets cut into 2 or more pages.
Here’s my updated code, it works by having different subs assigned to different buttons, and settings for sheetnumber and the graph name are passed as arguments:
Sub SaveGraph_DuurzameEnergieToedeling()
SaveGraphAs(0, "Object 1", "Duurzame Energie Toedeling")
End Sub
Sub SaveGraph_NieuwAansluitingen()
SaveGraphAs(1, "Object 2", "Nieuwe Aansluitingen")
End Sub
Sub SaveGraph_VerwerkingRestGFT_3()
SaveGraphAs(2, "Object 3", "Verwerking Rest en GFT (3 kolommen)")
End Sub
Sub SaveGraph_VerwerkingRestGFT_2()
SaveGraphAs(2, "Object 4", "Verwerking Rest (2 kolommen)")
End Sub
Sub SaveGraph_BundelingStromen()
SaveGraphAs(3, "Object 5", "Bundeling Stromen")
End Sub
Sub SaveGraph_HuishoudelijkRestafval_1()
SaveGraphAs(4, "Object 6", "Huishoudelijk Restafval")
End Sub
Sub SaveGraph_HuishoudelijkRestafval_2()
SaveGraphAs(4, "Object 7", "Afvalscheiding")
End Sub
Function SaveGraphAs(sheetIndex As Integer, graphName As String, graphFileName As String)
Dim fileDialog As Object
Dim fileURL As String
Dim sheets As Object
Dim oSheet As Object
' Get the sheet by index
sheets = ThisComponent.Sheets
oSheet = sheets.getByIndex(sheetIndex)
' Set the active sheet to the selected sheet
ThisComponent.CurrentController.setActiveSheet(oSheet)
' Debugging: Show which sheet is selected
' MsgBox "Selected Sheet: " & oSheet.Name & " (Index: " & sheetIndex & ")"
' Get the townName string from cell A68
Dim oCell As Object
Dim townName As String
oCell = oSheet.getCellRangeByName("A68")
townName = oCell.getString()
' Construct the default filename
Dim pdfFileName As String
pdfFileName = "Graph - " & townName & " - " & graphFileName & ".pdf"
' Create a FilePicker dialog for saving the file
fileDialog = createUnoService("com.sun.star.ui.dialogs.FilePicker")
fileDialog.initialize(Array(com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_SIMPLE))
fileDialog.Title = "Save Chart as PDF"
fileDialog.AppendFilter("PDF Files", "*.pdf")
fileDialog.SetDefaultName(pdfFileName)
fileDialog.setDisplayDirectory(ConvertToURL(ThisComponent.URL))
If fileDialog.Execute() = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
fileURL = fileDialog.Files(0)
Else
MsgBox "Save operation cancelled."
Exit Function
End If
' Call the ExportChartToPdf function
If ExportChartToPdf(oSheet, graphName, fileURL) Then
'MsgBox "Chart saved as PDF: " & ConvertFromURL(fileURL)
Else
MsgBox "Error on Chart save", MB_ICONEXCLAMATION
End If
End Function
' Export Calc Chart as Pdf.
' - oSheet Sheet object.
' - chartName Name of chart.
' - filePath File path (URL or OS format).
' Returns True if successful.
Function ExportChartToPdf(ByVal oSheet As Object, ByVal chartName As String, ByVal filePath As String) As Boolean
Dim oDoc As Object, oShape As Object, oShapeOLE As Object
Dim oProps1(1) As New com.sun.star.beans.PropertyValue ' for storeToURL
Dim oProps2(0) As New com.sun.star.beans.PropertyValue ' for FilterOptions
ExportChartToPdf = False
On Error GoTo ErrLabel
oDoc = oSheet.DrawPage.Forms.Parent
For Each oShape In oSheet.DrawPage
If oShape.supportsService("com.sun.star.drawing.OLE2Shape") Then
If oShape.PersistName = chartName Then
oShapeOLE = oShape
Exit For
End If
End If
Next oShape
If oShapeOLE Is Nothing Then
MsgBox "Chart not found!"
Exit Function
End If
' Explicitly select the chart
ThisComponent.CurrentController.Select(oShapeOLE)
' Wait for a moment to ensure the selection is processed
' oShapeOLE.update()
wait 1500
oProps2(0).Name = "Selection"
oProps2(0).Value = ThisComponent.CurrentSelection
oProps1(0).Name = "FilterName"
oProps1(0).Value = "calc_pdf_Export"
oProps1(1).Name = "FilterData"
oProps1(1).Value = oProps2
oDoc.storeToURL(ConvertToUrl(filePath), oProps1)
ExportChartToPdf = True
Exit Function
ErrLabel:
' Error handling (if needed)
MsgBox "An error occurred during export.", MB_ICONEXCLAMATION
End Function
' Helper function to pause for a moment
Sub Wait(milliseconds As Long)
Dim waitUntil As Double
waitUntil = Now + milliseconds / 86400000.0
Do While Now < waitUntil
' Do nothing, just wait
Loop
End Sub
Thanks!
