Exporta uma tabela como PDF

From The Document Foundation Wiki
< Macros‎ | Calc‎ | 016
Jump to: navigation, search

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

REM  *****  BASIC  *****
'Copyright (c) 2011 Frieder Delor, Mailto: Einfach hier im Forum anschreiben :-)
'A função: GetPath() é originária de: Copyright (c) 2011 Volker Lenhardt
'Este programa é software livre você pode redistribuir e/ou modificar este sob
'os termos da Licença Pública Geral GNU como publicada pela Fundação do Software Livre;
'seja a versão 2 da Licença ou (de sua opção) alguma versão posterior.

'Este programa é distribuído na esperança de que irá ser útil, mas, SEM NENHUMA
'GARANTIA; igualmente sem a garantia implicada de COMERCIALIZAÇÃO ou ADAPTAÇÃO
'PARA UM PROPÓSITO PARTICULAR. Veja a Licença Pública Geral GNU para mais detalhes.

'Você provavelmente deve ter recebido uma cópia da Licença Pública Geral GNU ao longo deste programa;
'se não, escreva para a Fundação do Software Livre, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
'==============================================================================
Sub Main
ExportToPDF ("Nome de Sua Tabela")
end sub
Sub ExportToPDF (sTableNam As String)
  sPath = GetPath
  If sPath = "" Then
    MsgBox "O caminho para arquivo não é válido.", 16, "Erro"
    goTo Zeile1
  End If 
  Zeile0:
  sStandard = "PDF_Exportado_" & Format(Now, "hh-mm")& "hrs_" & _
                    Format(Now,"dd.mm.yyyy") 
  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 Zeile0
    Else
      goTo Zeile1
    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 Zeile1
    Case 6 'Sim foi pressionado
    Case 7 'Não foi pressionado
      goTo Zeile0
    End Select 
  end if
  ThisComponent.addActionLock
  ThisComponent.LockControllers
  oDoc = ThisComponent
  oSheets = oDoc.Sheets
  oSheet1 =oDoc.Sheets.getByName(sTableNam) 
  Delete_PrintAreas
For n = 0 To oSheets.getCount - 1
  oSheet=oDoc.Sheets(n)
  if oSheet.Name= sTableNam 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, "PDF Exportado"

  Zeile1:
  ThisComponent.UnlockControllers 
  ThisComponent.removeActionLock
End sub
'-------------------------------------------
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
'----------------------------------------
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
'------------------------------------
Function GetLastUsedRow(oSheet as Object) As Integer 
  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
REM Retorna o número da última coluna
'de um intervalo de dados contínuo na planilha.
Function GetLastUsedColumn(oSheet as Object) As Long
  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
'----------------------------------
Function GetPath() As String
  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 
'------------------------------------
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 = "Imprimindo" ' 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"
'Somente a área selecionada para impressão será exportada.
  args2(2).Value = true

  ThisComponent.storeToURL(sFileName,args2())
end sub