none
[VBA] Copiar dados de Excel para Xcelsius RRS feed

  • Pergunta

  • Ola!!!!

    Tenho aqui uma questão um pouco rara, espero que alguem possa me ajudar.

    Estou tentando copiar alguns dados de um arquivo Excel (xls ou xlsx) para uma planilha Xcelsius (xlf)
    Como há muitas condições e detalhes que eu vou precisar fazer, estou fazendo essa copia de dados utilizando VBA, através do click de um botão na parte da planilha Excel do Xcelius.

    Só que acontece o seguinte, eu fiz no click do botao, aparecer uma janela para o usuario escolher um arquivo, e a partir do arquivo escolhido, e através do VBA abro essa planilha Excel, copio os dados que eu quero, e depois fecho a planilha.

    Quando eu rodo direto no VBA dando "play", roda normalmente. Mas quando rodo clicando no botão, ele dá o erro 1004, falando que não foi possivel executar o método Open de Workbooks.

    Analisando melhor, eu vi que outras funções que usam o Excel, como desabilitar as mensagens ou algo assim, também não funcionam quando eu clico no botão.

    Gostaria de saber se alguem conhece a explicação para isso acontecer.

    Ou se alguem tem alguma sugestão de outro metodo que eu possa utilizar para fazer isso que eu quero.

    Eu não tenho outra opção alem de transportar os dados de um Excel para o Xcelsius. =/

    Aqui vai meu código, que está no click do botão da minha planilha Xcelsius:
    Private Sub CommandButton1_Click()
        
        'Declara as variaveis que serão utilizadas
        Dim file_name
        Dim avarSplit As Variant
        Dim intIndex As Integer
        Dim source
        Dim WsTo As Worksheet, WsFrom As Worksheet
        
        'Pega o nome do WorkBook atual
        file_name = ThisWorkbook.FullName
        
        
        'Abre a janela para o usuario escolher o arquivo, e pega o caminho do arquivo
        source = Excel.Application.GetOpenFilename( _
            Title:="Please choose a file", _
            FileFilter:="Excel Files *.xlsx (*.*),")
        
        'Abre o arquivo escolhido
        Excel.Application.Workbooks.Open (source)
          
        'Trata a variavel para pegar apenas o nome do arquivo
        avarSplit = Split(source, "\")
        intIndex = UBound(avarSplit)
        source = avarSplit(intIndex)
        avarSplit = Split(source, ".")
        source = avarSplit(0)
        
       
        'Cria duas Sheets, uma de origem outra de destino
        Set WsTo = Workbooks(file_name).Sheets(3)
        Set WsFrom = Workbooks(source).Sheets(1)
    
        'Copia as informações que eu preciso
        WsTo.Range("C5", "C11") = WsFrom.Range("B9", "B15").Value
        
        'Fecha o arquivo que o usuario escolheu
        Excel.Application.Workbooks(source).Close
        
    End Sub

    Sei que é dificil, mas espero que alguem possa ajudar.

    Eu tirei a parte de abrir e fechar a planilha Excel escolhida pelo usuario, e pedi para o usuario fazer isso manualmente.

    Ai funciona.

    Mas eu gostaria de saber se tem como eu fazer essa função de abrir sozinho funcionar.

    Obrigada. 

    quinta-feira, 31 de maio de 2012 13:44

Respostas

  • Tente usar uma função auxiliar para evitar que o erro aconteça:

    Private Sub CommandButton1_Click()
        
        'Declara as variaveis que serão utilizadas
        Dim file_name
        Dim avarSplit As Variant
        Dim intIndex As Integer
        Dim source
        Dim WsTo As Worksheet, WsFrom As Worksheet
        
        'Pega o nome do WorkBook atual
        file_name = ThisWorkbook.FullName
        
        
        'Abre a janela para o usuario escolher o arquivo, e pega o caminho do arquivo
        source = GetArquivo
        
        If source = "" Then
            MsgBox "Selecione um arquivo!", vbCritical
            Exit Sub
        End If
        
        'Abre o arquivo escolhido
        Excel.Application.Workbooks.Open (source)
          
        'Trata a variavel para pegar apenas o nome do arquivo
        avarSplit = Split(source, "\")
        intIndex = UBound(avarSplit)
        source = avarSplit(intIndex)
        avarSplit = Split(source, ".")
        source = avarSplit(0)
        
       
        'Cria duas Sheets, uma de origem outra de destino
        Set WsTo = Workbooks(file_name).Sheets(3)
        Set WsFrom = Workbooks(source).Sheets(1)
    
        'Copia as informações que eu preciso
        WsTo.Range("C5", "C11") = WsFrom.Range("B9", "B15").Value
        
        'Fecha o arquivo que o usuario escolheu
        Excel.Application.Workbooks(source).Close
        
    End Sub
    
    Function GetArquivo() As String
        
        Dim sArquivo
        Dim sEspecificação As String
        Dim sTítulo As String
        
        sEspecificação = "Arquivos de Excel (*.xls*),*.xls*"
        sTítulo = "Selecione um arquivo do Excel:"
        
        sArquivo = CStr(Application.GetOpenFilename(sEspecificação, , sTítulo, , False))
        
        If sArquivo <> CStr(False) Then
            GetArquivo = sArquivo
        Else
            GetArquivo = ""
        End If
    
    End Function
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    domingo, 3 de junho de 2012 14:43
    Moderador