マクロ/Calc/016
TDF LibreOffice Document Liberation Project Community Blogs Weblate Nextcloud Redmine Ask LibreOffice Donate
説明
このマクロは、CalcシートをPDFにエクスポートします。 これは、マクロを使用せずに ▸ から "選択/選択したシート(s)" を選択することで実行できます。ただし、次に示すように、マクロを使用してこのプロセスを自動化/カスタマイズすることも出来ます。
この方法は、オペレーティング・システムに依存しません。
すべての印刷範囲が削除され、シートの使用領域が 印刷範囲 として定義され、PDFとしてエクスポートされます。
Main からサブルーチンを実行ます。そこでは引用符内にシート名を指定しておきます。
その後、マクロを使用できるようになります。以下に示すような Calc ファイルからマクロを開始するだけです。
Code
LibreOffice Basic:
' Copyright (c) 2011 Frieder Delor, Mailto: Einfach hier im Forum anschreiben :-)
' The function GetPath() is originally from: Copyright (c) 2011 Volker Lenhardt
' This program is free software you can redistribute it and/or modify it under
' the terms of the GNU General Public License as published by the Free Software
' Foundation; either version 2 of the License, or (at your option) any later
' version.
' This program is distributed in the hope that it will be useful, but WITHOUT
' ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
' FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
' You should have received a copy of the GNU General Public License along with
' this program; if not, write to the Free Software Foundation, Inc., 59 Temple
' Place, Suite 330, Boston, MA 02111-1307 USA
'Option Explicit
' <div lang="en" dir="ltr" class="mw-content-ltr">
Still need to implement Dims so that (^) option explicit works...
' Other than that the macro is working.
</div>
Sub Main()
ExportToPDF ("<span lang="en" dir="ltr" class="mw-content-ltr">Sheet1</span>") ' put Calc sheet name here
End Sub ' Main
Sub ExportToPDF (sSheetName As String)
MsgBox "<span lang="en" dir="ltr" class="mw-content-ltr">Choose path of where to export PDF</span>"
sPath = GetPath
If sPath = "" Then
MsgBox "<span lang="en" dir="ltr" class="mw-content-ltr">No valid file path.</span>", 16, "<span lang="en" dir="ltr" class="mw-content-ltr">Error</span>"
GoTo Section1
End If
Section0:
sStandard = "PDF_Export_" & sSheetName & "_" & Format(Now,"yyyy-mm-dd") & "_" & Format(Now, "hhmm")
sName=InputBox ("<span lang="en" dir="ltr" class="mw-content-ltr">Please give a name</span> " & Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">for the PDF file.</span>" , "<span lang="en" dir="ltr" class="mw-content-ltr">PDF Name</span>", sStandard )
If sName="" Then
nVar = MsgBox ("<span lang="en" dir="ltr" class="mw-content-ltr">You did not provide a name.</span> " & Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">Please give a name.</span> " & Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">If you click On ""Cancel""</span>, " & Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">the export will be stopped.</span>", 1, "<span lang="en" dir="ltr" class="mw-content-ltr">Error</span>")
If nVar = 1 Then ' <span lang="en" dir="ltr" class="mw-content-ltr">OK was clicked</span>
GoTo Section0
Else
GoTo Section1
End If
End If
sFileName= sName & ".pdf"
If FileExists(sPath & sFileName) Then
nVar=MsgBox ("<span lang="en" dir="ltr" class="mw-content-ltr">The file already exists.</span> " & Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">Should the file replaced?</span> " & Chr(10) & _
Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">If you click On ""Cancel""</span>, " & Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">the export will be stopped.</span>" & Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">If you click On ""No""</span>," & Chr(10) & _
"<span lang="en" dir="ltr" class="mw-content-ltr">you are able To provide another file name.</span>", 3, "<span lang="en" dir="ltr" class="mw-content-ltr">Error</span>")
Select Case nVar
Case 2 ' <span lang="en" dir="ltr" class="mw-content-ltr">Cancel was pressed</span>
GoTo Section1
Case 6 ' <span lang="en" dir="ltr" class="mw-content-ltr">Yes was pressed</span>
Case 7 ' <span lang="en" dir="ltr" class="mw-content-ltr">No was pressed</span>
GoTo Section0
End Select
End If
ThisComponent.addActionLock
ThisComponent.LockControllers
oDoc = ThisComponent
oSheets = oDoc.Sheets
oSheet1 = oDoc.Sheets.getByName(sSheetName)
Delete_PrintAreas
For n = 0 To oSheets.getCount - 1
oSheet=oDoc.Sheets(n)
If oSheet.Name= sSheetName Then
lEndCol= GetLastUsedColumn(oSheet1)
lEndRow=GetLastUsedRow(oSheet1)
Set_PrintAreas (n ,0 ,0 ,lEndCol ,lEndRow)
End If
Next
export_pdf(sPath & sFileName)
Delete_PrintAreas
MsgBox "<span lang="en" dir="ltr" class="mw-content-ltr">The PDF was successfully created.</span>" , 0, "ExportToPDF()"
Section1:
ThisComponent.UnlockControllers
ThisComponent.removeActionLock
End Sub ' ExportToPDF()
Sub Delete_PrintAreas()
'''<span lang="en" dir="ltr" class="mw-content-ltr">Delete all print areas.</span>'''
oDoc = ThisComponent
oSheet = oDoc.Sheets(0)
For n =0 To oDoc.Sheets.getCount - 1
oDoc.Sheets(n).setPrintAreas(Array ())
Next
End Sub ' Delete_PrintAreas()
Sub Set_PrintAreas (nSheet As Integer, lStartCol As Long, lStartRow As Long, lEndCol As Long, lEndRow As Long)
'''<span lang="en" dir="ltr" class="mw-content-ltr">Define the print area.</span>'''
Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
oDoc = ThisComponent
oSheet = oDoc.Sheets(nSheet)
CellRangeAddress.Sheet = nSheet
CellRangeAddress.StartColumn = lStartCol
CellRangeAddress.StartRow = lStartRow
CellRangeAddress.EndColumn = lEndCol
CellRangeAddress.EndRow = lEndRow
aPrintAreas() = Array (CellRangeAddress)
oSheet.setPrintAreas(aPrintAreas())
End Sub ' Set_PrintAreas
Function GetLastUsedRow(oSheet As Object) As Integer
'''<span lang="en" dir="ltr" class="mw-content-ltr">Returns integer of last used row.</span>'''
Dim oCell
Dim oCursor
Dim aAddress
oCell = oSheet.getCellByPosition(0, 0)
oCursor = oSheet.createCursorByRange(oCell)
oCursor.gotoEndOfUsedArea(True)
aAddress = oCursor.RangeAddress
GetLastUsedRow = aAddress.EndRow
End Function ' GetLastUsedRow
Function GetLastUsedColumn(oSheet As Object) As Long
'''<span lang="en" dir="ltr" class="mw-content-ltr">Returns the number of the last column of a continuous data range in a sheet.</span>'''
Dim oCell
Dim oCursor
Dim aAddress
oCell = oSheet.getCellByPosition(0, 0)
oCursor = oSheet.createCursorByRange(oCell)
oCursor.gotoEndOfUsedArea(True)
aAddress = oCursor.RangeAddress
GetLastUsedColumn = aAddress.EndColumn
End Function ' GetLastUsedColumn
Function GetPath() As String
'''<span lang="en" dir="ltr" class="mw-content-ltr">Returns path.</span>'''
Dim oPathSettings, oFolderDialog
Dim sPath As String
oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")
sPath = oPathSettings.Work
oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
oFolderDialog.SetDisplayDirectory(sPath)
If oFolderDialog.Execute() = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
sPath = oFolderDialog.GetDirectory
Else
GetPath = ""
Exit Function
End If
If Right(sPath, 1) <> "/" Then sPath = sPath & "/"
GetPath = sPath
End Function ' GetPath()
Sub export_pdf (sFileName As String)
Dim args1(1) As New com.sun.star.beans.PropertyValue
args1(0).Name = "ExportFormFields" ' <span lang="en" dir="ltr" class="mw-content-ltr">just show the contents of the Form.Fields</span>
args1(0).Value= TRUE
args1(1).Name = "Printing" ' <span lang="en" dir="ltr" class="mw-content-ltr">you don't need that</span>
args1(1).Value= 0 ' <span lang="en" dir="ltr" class="mw-content-ltr">more options could be added here</span>
Dim args2(2) As New com.sun.star.beans.PropertyValue
args2(0).Name = "FilterName"
args2(0).Value = "calc_pdf_Export"
args2(1).Name = "FilterData"
args2(1).Value = args1
args2(2).Name = "SelectionOnly"
' <span lang="en" dir="ltr" class="mw-content-ltr">Only the selected printing Area will we exported.</span>
args2(2).Value = TRUE
ThisComponent.storeToURL(sFileName,args2())
End Sub ' export_pdfODS file to test macro