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