Exporta somente uma planilha para um PDF

    From The Document Foundation Wiki
    < Macros‎ | Calc
    This page is a translated version of the page Macros/Calc/016 and the translation is 95% complete.
    Outdated translations are marked like this.


    Other languages:

    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

    Arquivo ODS para testar macro