Erro no laço "While / Wend"

[schiavinatto]

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)

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

[Conras]

@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.

[schiavinatto]

Ola @Conras, 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.

[Conras]

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?

[schiavinatto]

@Conras, 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.

[schiavinatto]

@Conras, parece o o problema existe desde 2011.

https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=42636

[schiavinatto]

@Conras, encontrei a solução

Dispatcher doesn't work in a Loop [Solved]

I am trying to paste the same text into multiple cells via a loop function: For n = 1 to TextTables(2).getRows().getCount() - 1 Range = TemplateDoc.TextTables(2).getCellByPosition(4, n) TemplateDoc.getCurrentController.select(Range) dim args2(0) as new com.sun.star.beans.PropertyValue args2(0).Name = "SelectedFormat" args2(0).Value = 10 dispatcher.executeDispatch(Frame, ".uno:ClipboardFormatItems", "", 0, args2()) Next Currently I am getting the following error after the fir…

Toda declaração Dim fora do While / Wend

Funcionou.

[Conras]

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

[schiavinatto]

Aguardando…

[Levi]

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?

[Conras]

@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

[schiavinatto]

Ok @Conras, perfeito, obrigado.