IMPORTAR DO EXCEL

USUARIO.EXCLUIDOS 31/05/2007 17:26:41
#219202
Olá galera.

Fiz um software para uma empresa que utilizava Excel, Excel puro, nem sei como eles organizavam os dados, mais isso não é importante, o importante é que eu gostaria de saber como eu faço para importar os dados do excel para minha aplicação ? detalhe ... gostaria que fosse via VB, via minha aplicação mesmo pois já tem dados e eu quero apenas adicionar, tem como ?

vlw a todos antecipadamente.
fuuii
USUARIO.EXCLUIDOS 31/05/2007 20:18:03
#219231
em componentes marque a opção Microsoft Common Dialog Control 6.0(SP6)
em referencia marque a versao do EXECEl que você vai utilizar, (versao nova abre uma versao anterior ao contrario não)
me.PB é um progressBar

Function Importar()
Dim cam As String
Dim NomePasta As String
Dim CaminhoPlanilha As String
Dim NomeTabela As String
Dim CaminhoBD As String
With Dialogo
    .DialogTitle = "Selecionar Planilha"
    .Filter = "Arquivo do Excel (*.xls)|*.xls"
    .filename = Empty
    .ShowOpen
    cam = .filename
End With
If cam = "" Or IsNull(cam) Then
Else
    Screen.MousePointer = 11
    LimpGrid
    Dim objExcel As Object
    Dim sTeste As String
    Set objExcel = CreateObject("Excel.Application")
    objExcel.Workbooks.Open (cam) 'Arquivo do excel que deseja abrir
    sTeste = 1
    Dim VL As Long
    Dim VL1 As Long
    Dim ToReg As Long
    VL = 2
    FrmInicial.SB.Panels(3) = "Verificando conteúdo dos dados da planilha"
    DoEvents
    Do While sTeste <> ""
        ToReg = ToReg + 1
        sTeste = objExcel.Cells(VL, 1)
        VL = VL + 1
        sTeste = objExcel.Cells(VL, 1)
    Loop
    Me.PB.Max = ToReg
    VL = 2
    VL1 = 0
    sTeste = 1
    Do While sTeste <> ""
        VL1 = VL1 + 1
        sTeste = Trim(objExcel.Cells(VL, 1))
        If sTeste = "" Or IsNull(sTeste) Then
            MsgBox "Campo Número do Item  " & Format(VL1, "0000") & "  está vazio", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Set objExcel = Nothing
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Exit Function
        ElseIf sTeste <= "0" Then
            MsgBox "Campo Número do Item  do Item " & Format(VL1, "0000") & "  não pode ser igual ou menor que Zero", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Set objExcel = Nothing
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Exit Function
        ElseIf IsNumeric(sTeste) Then
        Else
            MsgBox "Campo Número do item  " & Format(VL1, "0000") & "  deve ser numérico", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Set objExcel = Nothing
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Exit Function
        End If
        sTeste = Trim(objExcel.Cells(VL, 2))
        If sTeste = "" Or IsNull(sTeste) Then
            MsgBox "Campo Produto do Item  " & Format(VL1, "0000") & "  está vazio", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Set objExcel = Nothing
            Exit Function
        End If
        sTeste = Trim(objExcel.Cells(VL, 3))
        If sTeste = "" Or IsNull(sTeste) Then
            MsgBox "Campo Unidade do Item  " & Format(VL1, "0000") & "  está vazio", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Set objExcel = Nothing
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Exit Function
        ElseIf Len(sTeste) > 5 Then
            MsgBox "Campo Unidade do Item  " & Format(VL1, "0000") & "  está com mais de 5 caracteres", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Set objExcel = Nothing
            Screen.MousePointer = 0
            Exit Function
        End If
        sTeste = Trim(objExcel.Cells(VL, 4))
        If sTeste = "" Or IsNull(sTeste) Then
            MsgBox "Campo Qtde do Item  " & Format(VL1, "0000") & "  está vazio", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Set objExcel = Nothing
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Exit Function
        ElseIf IsNumeric(sTeste) Then
        Else
            MsgBox "Campo Qtde do Item  " & Format(VL1, "0000") & "  deve ser numérico", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Set objExcel = Nothing
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Exit Function
        End If
        sTeste = Trim(objExcel.Cells(VL, 5))
        If sTeste = "" Or IsNull(sTeste) Then
            MsgBox "Campo Valor do Item  " & Format(VL1, "0000") & "  está vazio", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Set objExcel = Nothing
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Exit Function
        ElseIf IsNumeric(sTeste) Then
        Else
            MsgBox "Campo Valor do Item  " & Format(VL1, "0000") & "  deve ser numérico", vbInformation, "Aviso do sistema"
            objExcel.ActiveWorkbook.Close
            Set objExcel = Nothing
            Me.PB.Visible = False
            FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
            Screen.MousePointer = 0
            Exit Function
        End If
        VL = VL + 1
        sTeste = objExcel.Cells(VL, 1)
        Me.PB.Value = VL1
    Loop
    Me.PB.Max = ToReg
    Me.PB.Visible = True
    VL = 2
    FrmInicial.SB.Panels(3) = "Exibindo registros da planilha"
    DoEvents
    I = 1
    sTeste = 1
    VL1 = 0

 'Aqui eu jogo os dados em msflexGrid, você pode jogar direto pro banco de dados

    Me.DBGrid.ScrollBars = flexScrollBarNone
    Dim Valo As Currency
    Do While sTeste <> ""
        VL1 = VL1 + 1
        DBGrid.Rows = I + 1
        sTeste = objExcel.Cells(VL, 1)
        DBGrid.TextMatrix(I, 1) = sTeste
        sTeste = objExcel.Cells(VL, 2)
        DBGrid.TextMatrix(I, 6) = sTeste
        sTeste = objExcel.Cells(VL, 3)
        DBGrid.TextMatrix(I, 2) = UCase(sTeste)
        sTeste = objExcel.Cells(VL, 4)
        DBGrid.TextMatrix(I, 3) = sTeste
        sTeste = objExcel.Cells(VL, 5)
        DBGrid.TextMatrix(I, 4) = Format(sTeste, "#,##0.00")
        DBGrid.TextMatrix(I, 5) = Format(CCur(objExcel.Cells(VL, 4)) * CCur(objExcel.Cells(VL, 5)), "#,##0.00")
        If Valo = 0 Then
            Valo = CCur(objExcel.Cells(VL, 4)) * CCur(objExcel.Cells(VL, 5))
        Else
            Valo = CCur(Valo) + CCur(objExcel.Cells(VL, 4)) * CCur(objExcel.Cells(VL, 5))
        End If
        ZEBRAR (I)
        Me.Existe = 1
        VL = VL + 1
        I = I + 1
        Me.PB.Value = VL1
        sTeste = objExcel.Cells(VL, 1)
    Loop
    Me.DBGrid.ScrollBars = 2
    Me.PB.Visible = False
    objExcel.ActiveWorkbook.Close
    Set objExcel = Nothing
    If I > 1 Then
        Import = True
        Me.Existe = 0
    End If
    Me.Label14.Caption = "Total da solicitação " & String(15, ".") & Format(Valo, "#,##0.00")
    FrmInicial.SB.Panels(3) = "Importar e Cadastrar Solicitação"
    Screen.MousePointer = 0
    FrmInicial.SB.Panels(3) = "Solicitação importada com sucesso - Click no botão Adicionar para salvar a solicitação"
End If
End Function
USUARIO.EXCLUIDOS 31/05/2007 20:46:32
#219235
Nooosaaa ...... que legal rsrsrs

Você teria tipo um projeto ? já com o MSFLEX e tals ? se tiver pode mandar em anexo aqui neste post ?

vlw hein !!!!!!
USUARIO.EXCLUIDOS 01/06/2007 04:37:55
#219267
Parei iniciantevb6, leia o código e entenda ... ninguém aqui está para resolver 100% de nossos problemas , mas o cara ae mandou pelo menos uns 99% pra vc.

Mereceu ser chamado atenção, desculpa!
USUARIO.EXCLUIDOS 01/06/2007 16:51:32
#219412
Bom... não sei qual seria sua necessidade, mas,
Eu faria uma simples conexão OLEDB e depois um select para criar recordset e transferia os dados para a aplicação.

Tipo como explicado nesse link, veja:
http://support.microsoft.com/kb/257819/pt-br#

Eu fiz assim e deu certo.
Mas, muito legal a opção acima.
USUARIO.EXCLUIDOS 04/06/2007 15:58:45
#219679
Citação:

EMERSON_TADEU escreveu:
Parei iniciantevb6, leia o código e entenda ... ninguém aqui está para resolver 100% de nossos problemas , mas o cara ae mandou pelo menos uns 99% pra vc.

Mereceu ser chamado atenção, desculpa!



Pedi para ele se ele podia ou tinha já um projeto pronto, nao disse para fazer um.

Já ouviu aquela frase que diz se não veio ajudar não atrapalhe ? pois é serve para você, quem e voce para me chamar atenção ?

Sem coment.
AAAFFFF
ESLEYSANCHES 04/06/2007 20:00:18
#219724
INICAINTEVB6 rsrrs cara você tem que deixar de ser estressado rsrs, pessoal esse usuário trabalha aqui comigo, gente fina ele, mais as vezes ele é meio ignorante mesmo, nem liguem não rsrrs.

Referente a dúvida, pelo amor de DEUS está esclarecido se VIRA uhauhauhauhuha

Espero que não tenha ajudado
Um Braço
ESLEYSANCHES 04/06/2007 20:03:10
#219725
Hããã, detalhe, se sua intenção for fazer isso para a integração com o sistema daqui, você se deu mal, eu já fiz huauhauha. Dê uma olhadinha lá, ou fale comigo que te mostro !!

brincadeiras a parte, eu realmente já terminei cara, fale comigo amanhã (se vc acessar hoje logicamente) que te passo o fonte... hãã detalhe, não esqueça de encerrar o tópico e pontuar o rapaz que te ajudou viu, ARNALDOCRUZ

flw cara !!
Tópico encerrado , respostas não são mais permitidas
Voltar