Exporta somente uma planilha para um PDF
Outdated translations are marked like this.
TDF LibreOffice Brasil Document Liberation Project Community Blogs Traduções Nextcloud Redmine Perguntas e respostas Doar
Descrição
Esta macro exporta somente uma planilha para um PDF.
Esta solução é independente de sistema operacional.
Todos os intervalos de impressão são deletados, então a área usada da planilha é definida como print range, então exportada como PDF.
O código tem de ser customizado: o "Nome de Sua Tabela" no procedimento "Sub Main" tem de ser modificado (somente a parte em negrito sem as aspas!).
Depois disso a macro está pronta para usar. Simplesmente inicie a macro de um arquivo Calc.
Código
Em 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
' Ainda precisa de implementar Dims para que (^) a opção explícita funcione...
' Tirando isso, a macro está funcionando.
Sub Main()
ExportToPDF ("Folha1") ' put Calc sheet name here
End Sub ' Main
Sub ExportToPDF (sSheetName As String)
MsgBox "O caminho para arquivo não é válido."
sPath = GetPath
If sPath = "" Then
MsgBox "O caminho para arquivo não é válido.", 16, "Erro"
GoTo Section1
End If
Section0:
sStandard = "PDF_Export_" & sSheetName & "_" & Format(Now,"yyyy-mm-dd") & "_" & Format(Now, "hhmm")
sName=InputBox ("Por favor, dê um nome " & Chr(10) & _
"para o arquivo PDF." , "PDF Name", sStandard )
If sName="" Then
nVar = MsgBox ("Você não deu um nome. " & Chr(10) & _
"Por favor, dê um nome. " & Chr(10) & _
"Se você pressionar ""Cancelar"", " & Chr(10) & _
"a exportação irá ser interrompida.", 1, "Erro")
If nVar = 1 Then ' OK foi pressionado
GoTo Section0
Else
GoTo Section1
End If
End If
sFileName= sName & ".pdf"
If FileExists(sPath & sFileName) Then
nVar=MsgBox ("O arquivo já existe. " & Chr(10) & _
"Quer substituir o arquivo? " & Chr(10) & _
Chr(10) & _
"Se você pressionar ""Cancelar"",, " & Chr(10) & _
"a exportação será interrompida." & Chr(10) & _
"Se você pressionar ""Não"",," & Chr(10) & _
"você poderá prover outro nome para o arquivo.", 3, "Erro")
Select Case nVar
Case 2 ' Cancelar foi pressionado
GoTo Section1
Case 6 ' Sim foi pressionado
Case 7 ' Não foi pressionado
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 "O PDF foi criado com sucesso." , 0, "ExportToPDF()"
Section1:
ThisComponent.UnlockControllers
ThisComponent.removeActionLock
End Sub ' ExportToPDF()
Sub Delete_PrintAreas()
'''Remove todas áreas de impressão'''
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 a área de impressão'''
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
'''Devolve o número inteiro da última fila usada.'''
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
'''Retorna o número da última coluna de um intervalo de dados contínuo na planilha.'''
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
'''retornar o caminho.'''
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" ' apenas mostra o conteúdo de Form.Fields
args1(0).Value= TRUE
args1(1).Name = "Printing" ' você não precisa disso.
args1(1).Value= 0 ' mais opções poderão ser adicionadas aqui
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_pdf