Enviando dados de um arquivo para outro via macro

Refiro-me a um complemento de uma pergunta anterior gentilmente respondida pelo @Grafeno, de como definir o endereco de colagem na macro. Agora, ao invés de enviar a outra planilha dentro do mesmo arquivo, gostaria de saber como enviar os dados a outro arquivo.

Eu googlei um tantinho e encontrei este link aqui:

https://forum.openoffice.org/en/forum/viewtopic.php?t=55228

Cuja solução está abaixo com minhas adaptações e comentários

Sub rangecopy
REM define os objetos
        Dim oDocA, oDocB, oSheetA As Object, Dummy(), oRangeA, targetcell as object
REM define o dispatcher
        oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
REM Documento A é o documento de origem, onde sua planilha está aberta
        oDocA = ThisComponent
REM Frame A é o frame do documento de origem
        oFrameA = oDocA.CurrentController.Frame
REM Planilha A é a primeira planilha, obtida aqui pelo índice zero, mas poderia ser também getByName("Planilha1")
        oSheetA = oDocA.getSheets.getByIndex(0)
REM Range A é o intervalo de interesse
        oRangeA = oSheetA.getCellRangeByName("C56:J56")
REM Ativa a seleção do intervalo Range A
        oDocA.CurrentController.Select(oRangeA)
REM Invoca o despachador para o comando de cópia
        oDispatcher.executeDispatch(oFrameA, ".uno:Copy", "", 0, Dummy())
REM 
REM Define o arquivo de destino. Troque "file://" pelo arquivo certo
REM 
        oDocB = StarDesktop.loadComponentFromURL ("file:///D:/DATI/prova/invoicelog.ods", "_blank",0, Dummy() )
REM  obtém a planilha 0 do arquivo de destino. pode usar também getByName("Planilha1")
        oSheetB = oDocB.getSheets.getByIndex(0)
REM define a célula de destino. Pode ser também .getCellRangeByName("A1")
        targetcell= oSheetB.getCellByPosition(0,0)
REM seleciona a célula de destino
        oDocB.CurrentController.Select(targetcell)
REM define o frame de destino
        oFrameB = oDocB.CurrentController.Frame
REM despacha a colagem
        oDispatcher.executeDispatch(oFrameB, ".uno:Paste", "", 0, Dummy())
REM fecha o arquivo B
         oDocB.Store
         oDocB.close(true)
End Sub
1 Like

Prezado Olivier, muito obrigado! Deu tudo certo, só no caso terei ainda que descobrir como inserir uma nova linha antes de colar os dados, para que os mesmo não se sobreponham. Acho que consigo. Valeu, mesmo sempre aprendi muito contigo durante estes anos.

Boa noite,


Conforme acertado com @Beto, posto aqui minha solução, que é uma adaptação do código da outra questão. No final, é diferente da apresentada pelo @ohallot porque não utiliza o Dispatcher.

No código abaixo, o outro arquivo é aberto no modo oculto para não causar nenhuma sobreposição na janela do arquivo origem.

Sub TransferirDados2
Dim oDoc As Object, oPlanOrigem As Object, oDocDestino as Object, oPlanDestino As Object
Dim sEndereco As String, sCol As String, sLin As String, sUrl As String
Dim iLin As Integer
Dim mArg(0) As New com.sun.star.beans.PropertyValue

	'Obter a planilhas de origem
	oDoc = ThisComponent
	oPlanOrigem = oDoc.Sheets.getByName( "Planilha2" )

	' Pegar o Endereço em B1 na planilha de origem
	sEndereco = oPlanOrigem.getCellRangeByName( "B1" ).String
	' Pegar a coluna e a linha definidas no endereço 
	sCol = Left( sEndereco,1 )
	sLin = Mid( sEndereco,2,Len( sEndereco ) )
	

	'Verificar se é um endereço válido
	If  Ucase( sCol ) <> "A" Or Not IsNumeric( sLin ) Then 
		MsgBox "Por favor, forneça um endereço correto.", 16, "Erro"
		Exit Sub
	End If


	'Abrir o arquivo destino como oculto e obter a planilha de destino
	mArg(0).Name = "Hidden"
	mArg(0).Value = True
	sUrl = convertToUrl("/home/grafeno/Área de Trabalho/Teste/Dados.ods") '<<< Caminho do arquivo destino
    ' No windows o caminho poderia ser, por exemplo, "D:\Teste\Dados.ods"
    oDocDestino = StarDesktop.loadComponentFromURL( sUrl, "_blank", 0, mArg() )
	oPlanDestino = oDocDestino.Sheets.getByName( "Planilha1" )
	
	' Transferir os valores
	iLin = cInt( sLin ) - 1 ' Menos 1 porque a posição das células começa com 0.
	oPlanDestino.getCellByPosition( 0,iLin ).String = Ucase(sEndereco)
	oPlanDestino.getCellByPosition( 1,iLin ).String = oPlanOrigem.getCellRangeByName( "B2" ).String
	oPlanDestino.getCellByPosition( 2,iLin ).Value = oPlanOrigem.getCellRangeByName( "B3" ).Value
	
	'Salvar e fechar o arquivo destino
	oDocDestino.Store
	oDocDestino.close(true)
	
	' Limpar o conteúdo do intervalo B1:B3
	' Argumentos do método clearContents:
	'  -> 1 para apagar valores
	'  -> 4 para apagar strings (texto)
	'  --> 1 + 4 = 5 apaga valores + string
	oPlanOrigem.getCellRangeByName( "B1:B3" ).clearContents( 5 )
End Sub

Atte,
Grafeno
1 Like

Já te considero um amigo, Grafeno. Tira-me uma dúvida: você não é o SP24h da lista? Pelo tanto que entende de macro sempre pensei que era. Quanto a tua macro: “Excelente”! É muito versátil, uma colaboração valiosa. Parabéns, novamente.

@Beto, não sou esse. Na verdade, hoje estou contribuindo apenas aqui no asklibo. Gosto da plataforma e de os demais contribuidores. Eu possuía um certo conhecimento em macros no Excel, mas foi por meio das perguntas, contribuições, revista, entre outros materiais, que consegui aprender um pouco da API do LibreOffice. Quanto a macro, sempre fico feliz em ajudar o/.