Macros/Calc/016
TDF LibreOffice en español Document Liberation Project Blogs comunitarios Weblate Nextcloud Redmine Preguntas y respuestas Donar
Descripción
Esta macro exporta una hoja de cálculo de Calc a PDF. Nótese que esto puede llevarse a cabo sin ayuda de las macros, tan solo vaya al menú ▸ y en el diálogo Opciones de PDF seleccione Intervalo > Selección/hojas seleccionadas.
Sin embargo, puede ser deseable automatizar o personalizar este proceso a través de una macro, como se muestra abajo:
La solución no depende del sistema operativo que se use para ejecutar LibreOffice.
Todas los intervalos de impresión preexistentes en el libro de cálculo serán borrados. Después se definirá un nuevo intervalo de impresión con el área seleccionada. Finalmente se hará la exportación a PDF.
Ejecute la subrutina Main y especifique entre comillas el nombre de la hoja.
Después de eso, la macro está lista para usarse. Simplemente ejecute la macro desde el libro de Calc, como la que se incluye más abajo.
Código en 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
' Aun es necesario declarar algunas Dim, de manera que Option Explicit funcione…
Sub Main()
ExportToPDF ("Hoja1") ' put Calc sheet name here
End Sub ' Main
Sub ExportToPDF (sSheetName As String)
MsgBox "Elija la ruta en donde se guardará el PDF resultante"
sPath = GetPath
If sPath = "" Then
MsgBox "No es una ruta válida para archivos.", 16, "Error"
GoTo Section1
End If
Section0:
sStandard = "PDF_Export_" & sSheetName & "_" & Format(Now,"yyyy-mm-dd") & "_" & Format(Now, "hhmm")
sName=InputBox ("Por favor proporcione un nombre " & Chr(10) & _
"para el PDF resultante." , "Nombre del PDF", sStandard )
If sName="" Then
nVar = MsgBox ("No ha proporcionado un nombre. " & Chr(10) & _
"Por favor proporcione un nombrepara el PDFresultante. " & Chr(10) & _
"Si pulsa el botón ""Cancelar"", " & Chr(10) & _
"el proceso de exportación se abortará.", 1, "Error")
If nVar = 1 Then ' Ha pulsado el botón ""OK""
GoTo Section0
Else
GoTo Section1
End If
End If
sFileName= sName & ".pdf"
If FileExists(sPath & sFileName) Then
nVar=MsgBox ("El archivo ya existe. " & Chr(10) & _
"¿Remplazo el archivo existente? " & Chr(10) & _
Chr(10) & _
"Si pulsa el botón ""Cancelar"", " & Chr(10) & _
"el proceso de exportación a PDF se abortará." & Chr(10) & _
"Si pulsa el botón ""No""," & Chr(10) & _
"podrá proporcionar otro nombre de archivo.", 3, "Error")
Select Case nVar
Case 2 ' Ha pulsado el botón ""Cancelar""
GoTo Section1
Case 6 ' Ha pulsado el botón ""Sí""
Case 7 ' Ha pulsado el botón ""No""
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 "El archivo PDF fue exitosamente creado." , 0, "ExportToPDF()"
Section1:
ThisComponent.UnlockControllers
ThisComponent.removeActionLock
End Sub ' ExportToPDF()
Sub Delete_PrintAreas()
'''Elimine todas las áreas de impresión.'''
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)
'''Define la zona de impresión.'''
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
'''Devuelve un número entero que corresponde a la última fila con datos.'''
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
'''Devuelve el número de la última columna dentro de un intervalo de datos en una hoja de cálculo.'''
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
'''Devuelve la ruta a un archivo.'''
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" ' Solo muestra el contenido de Forms.Fields (campos de formulario)
args1(0).Value= TRUE
args1(1).Name = "Printing" ' No necesita que
args1(1).Value= 0 ' más opciones puedan ser añadidas aquí
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"
' Solo la zona de impresión seleccionada se exportará a PDF.
args2(2).Value = TRUE
ThisComponent.storeToURL(sFileName,args2())
End Sub ' export_pdf