Exporta somente uma planilha para um PDF

From The Document Foundation Wiki
< Macros‎ | Calc
Jump to: navigation, search
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:
English • ‎español • ‎français • ‎italiano • ‎português do Brasil

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"
    ' Only the selected printing Area will we exported.
    args2(2).Value = TRUE
    
    ThisComponent.storeToURL(sFileName,args2())

End Sub ' export_pdf

Arquivo ODS para testar macro