Pergunte aqui
0

Enviando dados de um arquivo para outro via macro

perguntadas 2015-12-03 19:20:30 +0200

imagem do gravatar de Beto

updated 2016-02-02 21:19:13 +0200

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.

editar alterar tag assinalar como ofensivo fechar mesclar Excluir

2 Respostas

1

respondidas 2015-12-04 02:27:47 +0200

imagem do gravatar de Grafeno

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

editar assinalar como ofensivo Excluir Link mais

Comentários

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.

imagem do gravatar de BetoBeto ( 2015-12-04 12:22:02 +0200 )editar

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

imagem do gravatar de GrafenoGrafeno ( 2015-12-04 16:01:52 +0200 )editar
1

respondidas 2015-12-03 20:30:21 +0200

imagem do gravatar de Olivier

updated 2015-12-03 20:46:43 +0200

Eu googlei um tantinho e encontrei este link aqui:

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

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
editar assinalar como ofensivo Excluir Link mais

Comentários

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.

imagem do gravatar de BetoBeto ( 2015-12-04 12:18:43 +0200 )editar
Login/Registrar para responder

Ferramentas de perguntas

1 seguidor

Estatísticas

Perguntadas: 2015-12-03 19:20:30 +0200

Lidas: 1,330 vezes

Última atualização: Feb 02 '16