Pergunte aqui
0

Salvar arquivo PDF com mais de uma página de áreas diferentes

perguntadas 2020-05-27 04:37:53 +0100

imagem do gravatar de Schiavinatto

updated 2020-06-03 23:40:22 +0100

Tenho esta Macro, que funciona perfeitamente para uma área ( 1 página )

Sub ExportarPdf1
    Dim document as object
    Dim dispatcher as object
    Dim PlanImpressao As Object
    IrPara "NomeArquivoPDF" : Dim NomeArq As String
        NomeArq = ThisComponent.getCurrentSelection().getString()   
    IrPara "NomeDiretorioPDF" : Dim NomeDir As String 
        NomeDir = ThisComponent.getCurrentSelection().getString()
    DirPasta = NomeDir & "\" & NomeArq & ".pdf"
'=============================================================
                PlanImpressao = ThisComponent.Sheets.GetByName("CIs")
                intervaloimpressao = PlanImpressao.GetCellRangeByName("B6:T63")
                dim aFilterData(0) as new com.sun.star.beans.PropertyValue
                aFilterData(0).Name = "Selection"
                aFilterData(0).Value = intervaloimpressao
 '=============================================================     
    dim args1(1) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "URL"
    args1(0).Value = ConvertToURL( DirPasta )
    args1(1).Name = "FilterData" : args1(1).Value = aFilterData()
    CreateUnoService("com.sun.star.frame.DispatchHelper") _
    .executeDispatch(ThisComponent.CurrentController.Frame, ".uno:ExportDirectToPDF", "", 0, args1())
End Sub

E esta é uma SubMacro que a primeira usa:

Sub IrPara ( X As String )
'O############################################################################O
dim args1(0) as new com.sun.star.beans.PropertyValue : args1(0).Name = "ToPoint" : args1(0).Value = X
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args1())
End Sub

Meu problema é o seguinte quero salvar em PDF um arquivo mas tem duas páginas de áreas distintas, então eu substitui parte da macro, linhas entre os tracejados, para definir uma área e adicionar a segunda:

Sub ExportarPdf2
    Dim document as object
    Dim dispatcher as object
    Dim PlanImpressao As Object

    IrPara "NomeArquivoPDF" : Dim NomeArq As String
        NomeArq = ThisComponent.getCurrentSelection().getString()   

    IrPara "NomeDiretorioPDF" : Dim NomeDir As String 
        NomeDir = ThisComponent.getCurrentSelection().getString()

    DirPasta = NomeDir & "\" & NomeArq & ".pdf"

'=============================================================
    IrPara "PrintCI0" : Dim NomeArea As String  'célula com nome de área variável
        NomeArea = ThisComponent.getCurrentSelection().getString()
    IrPara NomeArea
    Execute "DefinePrintArea"       

    IrPara "PrintCI3"
    Execute "AddPrintArea"      
 '=============================================================     
    dim args1(1) as new com.sun.star.beans.PropertyValue
    args1(0).Name = "URL"
    args1(0).Value = ConvertToURL( DirPasta )
    args1(1).Name = "FilterData" : args1(1).Value = aFilterData()
    CreateUnoService("com.sun.star.frame.DispatchHelper") _
    .executeDispatch(ThisComponent.CurrentController.Frame, ".uno:ExportDirectToPDF", "", 0, args1())
End Sub

E esta é uma SubMacro que a, de cima, usa:

Sub Execute ( oQue$ )
CreateUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:" & oQue & "", "", 0, Array())
End Sub

Porem não dá certo, a geração do arquivo ocorre com todas as planilhas do arquivo. Aonde estou errando ?

editar alterar tag assinalar como ofensivo fechar mesclar Excluir

1 Resposta

1

respondidas 2020-05-27 14:40:18 +0100

imagem do gravatar de Conrado

updated 2020-05-27 18:46:46 +0100

@Schiavinatto

Segue atualização pensando em áreas diferentes.

Para isso, é necessário primeiramente definir as áreas conforme a seguir:

Descrição da imagem

Descrição da imagem

Depois utilize a macro. Ela vai imprimir cada "área de impressão" como se fosse uma página

Sub mySelectionExportToPDF()

    Dim pdfName As String
    Dim ArqName as String
    Dim Endereco As String
    Dim oDoc, oPlan, oPlan2
    Dim oRange1

        oDoc = ThisComponent
        oPlan = oDoc.Sheets.getByName( "Planilha1" )

        rem oRange1 = oPlan.GetCellRangeByName("PLAN1")

            Endereco = oPlan.getCellByPosition(1,2).String
            ArqName = oPlan.getCellByPosition(1,3).String

                pdfName = ArqName & ".pdf"

                rem change the path below as per your needs
                path =ConvertToURL(Endereco & pdfName)

    dim document as object
    dim dispatcher as object

        document = ThisComponent.CurrentController.Frame
        dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

            rem This part makes sure only the first page gets printed
            dim argsF(1) as new com.sun.star.beans.PropertyValue
            rem argsF(0).Name = "Selection"
            rem argsF(0).Value = oRange1
            argsF(0).Name = "Page"
            argsF(0).Value = "1; 2" rem o número de páginas representa todas as páginas do arquivo, independente do total de abas

            rem This part sets filename and references the properties above
            dim args1(1) as new com.sun.star.beans.PropertyValue
            args1(0).Name = "URL"
            args1(0).Value = path
            args1(1).Name = "FilterName"
            args1(1).Value = "calc_pdf_Export"
            args1(1).name = "FilterData"
            args1(1).value = argsF()

                dispatcher.executeDispatch(document, ".uno:ExportDirectToPDF", "", 0, args1())

End Sub

Utilizo essa macro. Neste comando argsF(0).Value = "1; 3" basta colocar as páginas que queira exportar como se fosse uma impressão.

Sub myExportToPDF()

    Dim pdfName As String
    Dim ArqName as String
    Dim Endereco As String
    Dim oDoc, oPlan

        oDoc = ThisComponent
        oPlan = oDoc.Sheets.getByName( "Planilha1" )

            Endereco = oPlan.getCellByPosition(1,2).String
            ArqName = oPlan.getCellByPosition(1,3).String

                pdfName = ArqName & ".pdf"

                rem change the path below as per your needs
                path =ConvertToURL(Endereco & pdfName)

    dim document as object
    dim dispatcher as object

        document = ThisComponent.CurrentController.Frame
        dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

            rem This part makes sure only the first page gets printed
            dim argsF(1) as new com.sun.star.beans.PropertyValue
            argsF(0).Name = "PageRange"
            argsF(0).Value = "4" rem o número de páginas representa todas as páginas do arquivo, independente do total de abas

            rem This part sets filename and references the properties above
            dim args1(1) as new com.sun.star.beans.PropertyValue
            args1(0).Name = "URL"
            args1(0).Value = path
            args1(1).Name = "FilterName"
            args1(1).Value = "calc_pdf_Export"
            args1(1).name = "FilterData"
            args1(1).value = argsF()

                dispatcher.executeDispatch(document, ".uno:ExportDirectToPDF", "", 0, args1())

End Sub
editar assinalar como ofensivo Excluir Link mais

Comentários

1

Ola @Conrado, obrigado novamente.

Uma outra alternativa que encontrei na internet, na macro de impressão, no começo Oculta as planilhas que não vai imprimir , comanda imprimir e no final da macro Desoculta as planilhas. Também funciona, mas acho que deva ter algo mais pratico.

imagem do gravatar de SchiavinattoSchiavinatto ( 2020-05-27 19:03:38 +0100 )editar

@Schiavinatto chegou a ver a macro que editei com base em área definida para impressão?

imagem do gravatar de ConradoConrado ( 2020-05-27 21:19:50 +0100 )editar

@Conrado, parece que não esta funcionando. Vou ver com mais calma a noite, ok, dou retorno aqui.

imagem do gravatar de SchiavinattoSchiavinatto ( 2020-05-27 21:41:44 +0100 )editar
Login/Registrar para responder

Ferramentas de perguntas

1 seguidor

Estatísticas

Perguntadas: 2020-05-27 04:37:53 +0100

Lidas: 28 vezes

Última atualização: May 27 '20