Pergunte aqui
1

Erro no laço "While / Wend"

perguntadas 2019-06-12 05:12:26 +0200

updated 2019-06-13 22:20:40 +0200

Montei macro para impressão com um While / Wend, na primeira passada ok, na segunda gera este erro, estou usando Win10 + LibO 6.2.4.2 (64)

Descrição da imagem

Alguém saberia traduzir.....

A macro completa é esta:

sub Imprimir
dim document, dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Save", "", 0, Array())
Wait 1000

dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "Cabeça"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$LISTAGEM.$A$1"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())

dim args7(5) as new com.sun.star.beans.PropertyValue
args7(0).Name = "Flags"
args7(0).Value = "A"
args7(1).Name = "FormulaCommand"
args7(1).Value = 0
args7(2).Name = "SkipEmptyCells"
args7(2).Value = false
args7(3).Name = "Transpose"
args7(3).Value = false
args7(4).Name = "AsLink"
args7(4).Value = false
args7(5).Name = "MoveMode"
args7(5).Value = 0
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args7())

dim args8(1) as new com.sun.star.beans.PropertyValue
args8(0).Name = "By"
args8(0).Value = 23
args8(1).Name = "Sel"
args8(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args8())

    oSel = ThisComponent.getCurrentSelection()
    Var1 = oSel.getString()

    While Var1 <> ""

dim args13(5) as new com.sun.star.beans.PropertyValue
args13(0).Name = "Flags"
args13(0).Value = "A"
args13(1).Name = "FormulaCommand"
args13(1).Value = 0
args13(2).Name = "SkipEmptyCells"
args13(2).Value = false
args13(3).Name = "Transpose"
args13(3).Value = false
args13(4).Name = "AsLink"
args13(4).Value = false
args13(5).Name = "MoveMode"
args13(5).Value = 0
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args13())  '<===== ERRO AQUI

dim args18(1) as new com.sun.star.beans.PropertyValue
args18(0).Name = "By"
args18(0).Value = 23
args18(1).Name = "Sel"
args18(1).Value = false
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args18())

    oSel = ThisComponent.getCurrentSelection()
    Var1 = oSel.getString()

    Wend

dim args21(0) as new com.sun.star.beans.PropertyValue
args21(0).Name = "ToPoint"
args21(0).Value = "Rodape"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args21())
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())

dim args23(0) as new com.sun.star.beans.PropertyValue
args23(0).Name = "ToPoint"
args23(0).Value = "$LISTAGEM.$A$1"
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args23())

dispatcher.executeDispatch(document, ".uno:GoDownToEndOfData", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())

dim args27(0) as new com.sun.star.beans.PropertyValue
args27(0).Name = "ToPoint"
args27(0).Value = "$LISTAGEM.$A$1:$J$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args27())
dispatcher.executeDispatch(document, ".uno:GoDownToEndOfDataSel", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:DefinePrintArea", "", 0, Array())
dispatcher.executeDispatch(document, ".uno:Print", "", 0, Array())

end Sub
editar alterar tag assinalar como ofensivo fechar mesclar Excluir

Comentários

@Gilberto Schiavinatto ... este comando "dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args13()" é para inserir algum argumento copiado correto? Não consigo ainda interpretar muito este modo de macro. Explique o que precisa melhor para ver se consigo te ajudar.

imagem do gravatar de ConradoConrado ( 2019-06-12 12:45:27 +0200 )editar

Ola @Conrado, tenho 3 planilhas (LISTAGEM, Cab e Rod). Após preencher LISTAGEM, pode ser algumas linhas ou dezenas, aciono a macro para gerar a paginação tipo formulário, na qual tem a numeração de página. A macro Salvar o arquivo, copia Cabeça (Cabeçalho) vai para a LISTAGEM.A1 e cola inserindo linhas, desce 23 linhas, WHILE checa se tem dados na célula, se sim repete a colagem WEND se não copia Rodape vai para LISTAGEM.A1 desce até a primeira vazia e cola, seleciona a área e define para impressão e envia para impressora.

imagem do gravatar de Gilberto SchiavinattoGilberto Schiavinatto ( 2019-06-12 13:24:34 +0200 )editar

O seu padrão de cabeçalho e rodapé está na planilha Cab (cabeçalho) e Rod (rodapé)?

Outra dúvida, quantas operações pode existir de copiar e colar? Pois a While Var1 <> "" que você colocou, ela vai terminar na 23ª linha, em vez disso, será que ela não deveria ter com Count sobre quantas operações ela deveria copiar e colar?

imagem do gravatar de ConradoConrado ( 2019-06-12 14:00:31 +0200 )editar

@Conrado, Cab e Rod Ok

Var1 verifica se ainda a dados, se vazio significa que a lista acabou, então colar Radape

Em Cab.M3, tem a previsão de paginas.

imagem do gravatar de Gilberto SchiavinattoGilberto Schiavinatto ( 2019-06-12 15:22:37 +0200 )editar

@Conrado, parece o o problema existe desde 2011.

https://forum.openoffice.org/en/forum...

imagem do gravatar de Gilberto SchiavinattoGilberto Schiavinatto ( 2019-06-12 19:20:57 +0200 )editar

@Conrado, encontrei a solução

https://ask.libreoffice.org/en/questi...

Toda declaração Dim fora do While / Wend

Funcionou.

imagem do gravatar de Gilberto SchiavinattoGilberto Schiavinatto ( 2019-06-12 19:46:55 +0200 )editar

Ótimo....estou montando uma via basic para deixar mais fácil entendimento e posto aqui também

imagem do gravatar de ConradoConrado ( 2019-06-12 21:28:03 +0200 )editar

Aguardando....

imagem do gravatar de Gilberto SchiavinattoGilberto Schiavinatto ( 2019-06-13 00:51:03 +0200 )editar

Isso foi um caso de declaração de variável local (apenas dentro do laço)? Seria necessária a criação de uma outra rotina na qual o "While" (laço, loop) possuísse o endereçamento da mesma em seu interior e nesta, a declaração das novas variáveis?

imagem do gravatar de LeviLevi ( 2019-06-18 06:42:53 +0200 )editar

1 Resposta

1

respondidas 2019-06-13 18:39:19 +0200

imagem do gravatar de Conrado

@Gilberto Schiavinatto

Dá uma olhada, teste e depois me informa.

Fiz todos os comentários possíveis, por isso ficou extensa.

Você vai precisar ajustar a altura de linhas talvez. Na minha impressora não ficou cada página em 01 página.

Qualquer dúvida, só chamar.

    Sub AjustarListagem

    Dim oDoc, oController, oPrint, oListagem, oCab, oRod as Object
    Dim rCab, rRod as Object 'Matriz do Cabeçalho e Rodapé
    Dim rDestCab, rDestRod as Object 'Local para Colar Cabeçalho e Rodapé
    Dim oCopiaCab, oCopiaRod as Variant
    Dim oColaCab, oColaRod as Variant
    Dim i, UltimaLinha as Long
    Dim sVar1 as String
    Dim oRangeAddress(0) As new com.sun.star.table.CellRangeAddress
    Dim oRange

    oDoc = ThisComponent
    oPrint = oDoc.CurrentController.ActiveSheet

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

    oListagem = oDoc.Sheets.getByName("Listagem")
    oCab = oDoc.Sheets.getByName("Cab")
    oRod = oDoc.Sheets.getByName("Rod")

    Rem Definição da variável para os nomes definidos na planilha
    rCab = oDoc.NamedRanges.getByName("Cabeça").getReferredCells
    rRod = oDoc.NamedRanges.getByName("Rodape").getReferredCells

    Rem Comando para salvar a planilha
    dispatcher.ExecuteDispatch(document, ".uno:Save", "", 0, Array())

    rem procedimento para identificar a última linha
    rem cria um curso iniciado na célula A1
    c = oListagem.CreateCursor
    rem Percorre até última céluala preenchida (função ctrl + end do teclado)
    c.GoToEndOfUsedArea(False)
    rem identifica a última linha
    UltimaLinha = c.RangeAddress.EndRow + 1

    For i = 1 to UltimaLinha Step 23 + 6
        sVar1 = oListagem.getCellRangeByName("A" & i).String
        If sVar1 <> "" Then
        rem Defini a linha para inserir
        oListagem.Rows.insertByIndex(i - 1,6)
        rem Ajusta a altura da linha 100 = 0,1
        oListagem.getRows(i - 1 + 6).Height = 800
        rem copia os dados do nome Cab
        oCopiaCab = rCab.RangeAddress
        rem defini a célula de destino para receber os dados copiados
        rDestCab = oListagem.GetCellByPosition(0,  i - 1)
        rem defini o endereço para processo de colagem
        oColaCab = rDestCab.CellAddress
        rem função colar
        oListagem.CopyRange(oColaCab, oCopiaCab)
        rem pula as linhas para verificar se existe conteúdo para próxima página
        UltimaLinha = UltimaLinha + 6
        End If
    Next i

    rem copia os dados do nome Rod
    oCopiaRod = rRod.RangeAddress
    rem defini a célula de destino para receber os dados copiados
    rDestRod = oListagem.GetCellByPosition(0,  UltimaLinha)
    rem defini o endereço para processo de colagem
    oColaRod = rDestRod.CellAddress
    rem função colar
    oListagem.CopyRange(oColaRod, oCopiaRod)

    rem comando para remover todas quebras de página
    oPrint.removeAllManualPageBreaks()
    rem identificação da matriz da planilha
    oRange = oPrint.getCellRangeByPosition(0, 0, 11, UltimaLinha + 4) rem StartCol, StartRow, EndCol, EndRow
    rem definição do endereço da matriz
    oRangeAddress(0) = oRange.getRangeAddress()
    rem definindo a area de impressão
    oPrint.setPrintAreas(oRangeAddress())

    rem defini a planilha corrente de controle
    oController = oDoc.getCurrentController()
    rem seleciona célula A1
    oController.select(oListagem.getCellByPosition(0, 0))

    dispatcher.executeDispatch(document, ".uno:Print", "", 0, Array())

End Sub
editar assinalar como ofensivo Excluir Link mais

Comentários

1

Ok @Conrado, perfeito, obrigado.

imagem do gravatar de Gilberto SchiavinattoGilberto Schiavinatto ( 2019-06-13 22:19:46 +0200 )editar
Login/Registrar para responder

Ferramentas de perguntas

1 seguidor

Estatísticas

Perguntadas: 2019-06-12 05:12:26 +0200

Lidas: 19 vezes

Última atualização: Jun 13