Subscrever linha

afbergman · Mensagem por **afbergman** » Dom Mar 29, 2015 8:08 am

Pessoal boa noite,

Criei um formulario de agenda telefonica e estou com uma dificuldade.
Utilizo o listview, e nele coloquei a função DblClick. Quando clico duas vezes na linha, preencho as textbox.

Adaptei um botao chamado "Atualizar", que caso precise atualizar algum dado de um contato gravado, basta clicar duas vezes na linha do listview e dps editar nas textbox o que quer, e em seguida clicar em "Atualizar".

O problema é que ao fazer esse procedimento, ele cria uma linha nova com os dados atualizados. Na verdade o que eu quero é que ele subscreva a linha.
Entenderam?? Irei colocar meu projeto disponivel.

Obrigado.

rafaelsetti · Mensagem por **rafaelsetti** » Dom Mar 29, 2015 10:24 am

bom dia afbergman ,

Eu testei aqui seu programa e ele altera perfeitamente sobrescrevendo a linha correspondente do cadastro. Não entendi o que vc realmente deseja.....

obrigado,

Rafael

afbergman · Mensagem por **afbergman** » Dom Mar 29, 2015 3:13 pm

Rafael,

É vdd, esqueci desse detalhe. Aproveitando a ajuda, queria transforma-la e começar a trabalhar com banco de dados pelo acess.
Sabe alguma coisa que poderia me ajudar??

Abs

rafaelsetti · Mensagem por **rafaelsetti** » Dom Mar 29, 2015 4:05 pm

Este é um exemplo do que eu fiz em um sistema vc agora pode alterar para o seu!!!

Código: Selecionar todos

Sub inserir()

Dim BD As Database
    Dim dt As Recordset
    



     
        Dim CADASTRO(1 To 15)

            CADASTRO(1) = UCase(Me.TextCLIENTE.Text)

            CADASTRO(2) = UCase(Me.TexTPROF.Text)

            CADASTRO(3) = UCase(Me.TextSERVICO.Text)

            CADASTRO(4) = UCase(Me.TextDATA.Text)

            CADASTRO(5) = LCase(Me.TexTEMAIL.Text)

             CADASTRO(6) = UCase(Me.TEXTOBSERVACAO.Text)
          
            TextCLIENTE.Text = CADASTRO(1)
            TexTPROF.Text = CADASTRO(2)
            TextSERVICO.Text = CADASTRO(3)
            TexTEMAIL.Text = CADASTRO(5)
        
            
    
               If Len(Me.TextCLIENTE) = 0 Then

                MsgBox "VOCÊ NÃO DIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DE CLIENTES"

                Else
                                 Set BD = OpenDatabase("\\servidor\REAL FEET\database\realfeet.mdb")
    Set rs = BD.OpenRecordset("AGENDAMENTO")
    
    If Me.TextOS.Text = "" Then
      MsgBox "INSIRA UM CÓDIGO DE OS VÁLIDO"
      Me.TextOS.SetFocus
      Exit Sub
    End If

     ' os campos na tabela já estão criados, DataNascimento e CodigoPostal
     
     ' falta somente os textboxes rerentes a eles  e adicionar abaixo no código (rs.DastaNscimento e rs.CodigoPostal)
   cont = rs.RecordCount
   If Count > 0 Then
      rs.MoveFirst
   End If
    Dim OS As Integer
    OS = TextOS
    
    For i = 1 To cont
VOLTAR:
       'adicione os  ítens a ser criados aqui!!!!!!!
    If rs!OS = OS Then
    MsgBox ("CÓDIGO DE OS JÁ CADASTRADO")
    resp = 1
    GoTo FIM2
    End If
    Next
    If resp <> 1 Then
    rs.AddNew
    rs!OS = Me.TextOS.Text
    rs!NOME = Me.TextCLIENTE.Text
   
    rs!DATA = Me.TextDATA.Text
    rs!HORA = Me.TexTHORA.Text
       rs!fone1 = Me.TextTELRES.Text
    rs!fone2 = Me.TexttelCEL
       
    rs!RAMAL = Me.TextRAMAL
    rs!Email = Me.TexTEMAIL
    rs!SERVICO = Me.TextSERVICO
    rs!PROFISSIONAL = Me.TexTPROF
    rs!Porcentagem = Me.TextPORCENTAGEM
    rs!Data_PROX_AGENDAMENTO = Me.Textprox
    rs!HORA_PROX_AGENDAMENTO = Me.TextHORAPROX
    Carrega_imagem3
    rs!PRONTUARIO = Me.TEXTPRONTUARIO.Text
    rs!FOTO_POS = Me.TEXTFOTODEPOIS.Text
    rs!PRECO = Me.TEXTPRECO.Text
    
    
    rs.Update
    rs.Close
    BD.Close
    MsgBox ("DADOS INSERIDOS COM SUCESSO!"), vbInformation
    Me.TextOS = Null
    Me.TextCLIENTE = Null
    Me.TextDATA = Null
    Me.TexTHORA = Null
    Me.TextTELRES = Null
    Me.TexttelCEL = Null
    Me.TextRAMAL = Null
    Me.TexTEMAIL = Null
    Me.TextSERVICO = Null
    Me.TexTPROF = Null
    Me.TextPORCENTAGEM = Null
    Me.Textprox = Null
    Me.TextHORAPROX = Null
    Me.IMAGEDEPOIS.Picture = Nothing
    Me.ImageANTES.Picture = Nothing
    Me.IMAGEPRONTUARIO.Picture = Nothing
    TEXTPRONTUARIO = Null
    TEXTDEPOIS = Null
    TEXTPRECO = Null
    Textday = Null
    TEXTOBSERVACAO = Null
    Me.TextOS.SetFocus
    C0NT = cont + 1
GoTo FIM
FIM2:
 
End If


       If cont = 0 Then
       GoTo VOLTAR
       End If

FIM:

 

End If
CommandButton4.Enabled = False
CommandButton5.Enabled = False
CommandButton6.Enabled = False
CommandButton7.Enabled = False
CommandButton12.Enabled = False


End Sub



Private Sub CommandCONSULTAR_Click()
'Selecione a referencia do vba Microsoft DAO 3.6 Object Library dans ferramentas Referencia
    Dim BD As Database
    Dim dt As Recordset
    

                    
    
    
               If Len(Me.TextCLIENTE.Text) = 0 Then

                MsgBox "VOCÊ NÃO DIGITOU NENHUM NOME PARA CONSULTA", vbCritical, "CADASTRO DE CLIENTES"

                Else
                 Set BD = OpenDatabase("\\SERVIDOR\REAL FEET\database\realfeet.mdb")
    Set rs = BD.OpenRecordset("cliente")
    
    
     ' os campos na tabela já estão criados, DataNascimento e CodigoPostal
     ' falta somente os textboxes rerentes a eles  e adicionar abaixo no código (rs.DastaNscimento e rs.CodigoPostal)

    'adicione os  ítens a ser criados aqui!!!!!!
 Dim CADASTRO(1 To 15)

            CADASTRO(1) = UCase(Me.TextCLIENTE.Text)

            CADASTRO(2) = UCase(Me.TextRG.Text)

            CADASTRO(3) = UCase(Me.TextCPF.Text)

            CADASTRO(4) = UCase(Me.TextDATA.Text)

            CADASTRO(5) = UCase(Me.TextENDERECO.Text)

             CADASTRO(5) = UCase(Me.TextENDERECO.Text)
          
            CADASTRO(6) = UCase(Me.TextN.Text)
            CADASTRO(7) = UCase(Me.TextBAIRRO.Text)
 CADASTRO(8) = UCase(Me.ComboCIDADE.Text)
 CADASTRO(9) = UCase(Me.ComboUF.Text)
 CADASTRO(10) = UCase(Me.TextCEP.Text)
 CADASTRO(11) = UCase(Me.TextTELRES.Text)
 CADASTRO(12) = UCase(Me.TexttelCEL.Text)

CADASTRO(14) = UCase(Me.TextRAMAL.Text)
CADASTRO(15) = UCase(Me.TexTEMAIL.Text)
TextCLIENTE.Text = CADASTRO(1)
TextENDERECO.Text = CADASTRO(5)
TextBAIRRO.Text = CADASTRO(7)
ComboCIDADE.Text = CADASTRO(8)
ComboUF.Text = CADASTRO(9)

          Call TiraAcento(linha)
          rs.MoveFirst
          Count = rs.RecordCount
          For i = 1 To Count
          If rs!NOME = Me.TextCLIENTE.Text Then
    
     Me.Textcod.Text = rs!codigo
     Me.TextCLIENTE = rs!NOME
   
    Me.TextRG = rs!RG
     Me.TextCPF = rs!CPF
        Me.TextDATA = rs!DATANASCIMENTO
    Me.TextENDERECO = rs!endereco
       
   Me.TextN = rs!N
     Me.TextBAIRRO = rs!BAIRRO
     Me.ComboCIDADE = rs!CIDADE
    Me.ComboUF = rs!UF
     Me.TextCEP = rs!cep
     Me.TextTELRES = rs!fone1
     Me.TexttelCEL = rs!fone2
     Me.TextRAMAL = rs!RAMAL
     Me.TexTEMAIL = rs!Email
     Me.textcaminhopath = rs!FOTO
    Carrega_imagem2_Click
    MsgBox ("Dados consultados no Banco de Dados Access com Sucesso!"), vbInformation
    rs.MoveNext
    GoTo fim4
 rs.MoveNext
 End If
 rs.MoveNext
 Next
GOTOFIM3:
FIM2:
FIM3:
MsgBox ("CLIENTE NÃO CADASTRADO")
fim4:

rs.Close
    BD.Close
       
       Exit Sub

End If
CommandButton4.Enabled = False
CommandButton5.Enabled = False
CommandButton6.Enabled = False
CommandButton7.Enabled = False
CommandButton12.Enabled = False


End Sub
Private Sub CommandEXCLUIR_Click()



'Private Sub CommandButton2_Click()
'CommandINCLUIR_Click
'End Sub
Sub pega_tabela()
    
    Set ie = CreateObject("InternetExplorer.Application")
    With ie
        .Width = 800
        .Height = 600
        .Resizable = False
        .AddressBar = False
        .Top = 60
        .Left = 560
        .Visible = False
        .Navigate "http://www.buscacep.correios.com.br/"
        Do Until .ReadyState = 4: DoEvents: Loop
        Set myTextField = .Document.all.item("relaxation")
        myTextField.Value = UserForm1.TextCEP
        ie.Document.Forms(0).Submit
              
        Do Until .ReadyState = 4: DoEvents: Loop
        Do While .Busy: DoEvents: Loop
        Set doc = ie.Document
        
        Do While ie.LocationURL <> "http://www.buscacep.correios.com.br/servicos/dnec/consultaEnderecoAction.do"
        Loop

        If ie.LocationURL = "http://www.buscacep.correios.com.br/servicos/dnec/consultaEnderecoAction.do" Then
        Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE:
        Loop
        End If
                      
        puxa_dados doc, 3 ' 3 é referente a terceira tabela da página....
        
        .Quit
    End With
    
End Sub
CommandButton4.Enabled = False
CommandButton5.Enabled = False
CommandButton6.Enabled = False
CommandButton7.Enabled = False
CommandButton12.Enabled = False

Private Sub CommandButton5_Click()
 'Selecione a referencia do vba Microsoft DAO 3.6 Object Library dans ferramentas Referencia
    Dim BD As Database
    Dim dt As Recordset
    


Dim CADASTRO(1 To 15)
     
        CADASTRO(1) = UCase(Me.TextCLIENTE.Text)

            CADASTRO(2) = UCase(Me.TextSERVICO.Text)

            CADASTRO(3) = UCase(Me.TexTPROF.Text)

            CADASTRO(4) = LCase(Me.TexTEMAIL.Text)
 CADASTRO(11) = UCase(Me.TextTELRES.Text)
 CADASTRO(12) = UCase(Me.TexttelCEL.Text)
CADASTRO(14) = UCase(Me.TextRAMAL.Text)
            TextSERVICO.Text = CADASTRO(2)
            TexTPROF.Text = CADASTRO(3)
    
               If Len(Me.TextCLIENTE) = 0 Then

                MsgBox "VOCÊ NÃO DIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DE CLIENTES"

                Else
                 Set BD = OpenDatabase("\\servidor\REAL FEET\database\realfeet.mdb")
    Set rs = BD.OpenRecordset("agendamento")
    
    If Me.TextOS.Text = "" Then
      MsgBox "Insira um código de OS válido"
      Me.TextOS.SetFocus
      Exit Sub
    End If

     ' os campos na tabela já estão criados, DataNascimento e CodigoPostal
     ' falta somente os textboxes rerentes a eles  e adicionar abaixo no código (rs.DastaNscimento e rs.CodigoPostal)

      'adicione os  ítens a ser criados aqui!!!!!!!
    End If
    Dim OS As Integer
    OS = TextOS
    rs.MoveFirst
    Count = rs.RecordCount
    For i = 1 To Count
    If OS = rs!OS Then
    rs.Edit
    rs!NOME = Me.TextCLIENTE
    rs!DATA = Me.TextDATA
    rs!HORA = Me.TexTHORA
       rs!fone1 = Me.TextTELRES
    rs!fone2 = Me.TexttelCEL
       
    rs!RAMAL = Me.TextRAMAL
    rs!Email = Me.TexTEMAIL
    rs!SERVICO = Me.TextSERVICO
    rs!PROFISSIONAL = Me.TexTPROF
    rs!Data_PROX_AGENDAMENTO = Me.Textprox
    rs!HORA_PROX_AGENDAMENTO = Me.TextHORAPROX
    Carrega_imagem3
    rs!PRONTUARIO = Me.TEXTPRONTUARIO
    rs!FOTO_POS = Me.TEXTFOTODEPOIS
    rs!PRECO = Me.TEXTPRECO
    rs.Update
    GoTo FIM:
    
    rs.MoveNext
    End If
    Next
    rs.Close
    BD.Close
FIM:
    MsgBox ("DADOS ALTERADOS COM SUCESSO!"), vbInformation
    Me.TextOS = Null
    Me.TextCLIENTE = Null
    Me.TextDATA = Null
    Me.TexTHORA = Null
    Me.TextTELRES = Null
    Me.TexttelCEL = Null
    Me.TextTELCOM = Null
    Me.TextRAMAL = Null
    Me.TexTEMAIL = Null
    Me.TextSERVICO = Null
    Me.TexTPROF = Null
    Me.TextPORCENTAGEM = Null
    Me.Textprox = Null
    Me.TextHORAPROX = Null
    Me.IMAGEPRONTUARIO.Picture = Nothing
    Me.ImageANTES.Picture = Nothing
    Me.IMAGEDEPOIS.Picture = Nothing
    Me.TEXTPRONTUARIO = Null
    Me.TEXTFOTODEPOIS = Null
    TEXTPRECO = Null
    Textday = Null
    TEXTCONSULTA = Null
    TextRETORNO = Null
        Me.TextOS.SetFocus
    

FIM2:
 
       Exit Sub



 
CommandButton4.Enabled = False
CommandButton5.Enabled = False
CommandButton6.Enabled = False
CommandButton7.Enabled = False
CommandButton12.Enabled = False



End Sub

Private Sub Textpesquisanome_Change() ‘listbox
  Dim nConn As New ADODB.Connection
   Dim nConn2 As New ADODB.Connection
    Dim BANCO As ADODB.Recordset
    Dim BANCO1 As ADODB.Recordset
    Dim SQL As String
    Dim SQL2 As String
    Dim Count

    Dim nConectar As String
    Dim nConectar2 As String
    'Endereço e nome do banco de dados       * habilite o provedor de acordo c/ sua versao:
   ' nConectar = "Provider=Microsoft.Jet.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\base.mdb"
    nConectar = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "\\servidor\REAL FEET\DATABASE\REALFEET.MDB"
    nConn.ConnectionString = nConectar
    nConn.Open
    nConectar2 = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "\\servidor\REAL FEET\DATABASE\REALFEET.MDB"
    nConn2.ConnectionString = nConectar2
    nConn2.Open
 Set BANCO1 = New ADODB.Recordset
  BANCO1.Open ("AGENDAMENTO"), nConn2
Dim i As Integer

i = 0

Me.Listview1.ListItems.Clear
    Me.Listview1.ColumnHeaders.Clear
    Me.Listview1.View = lvwReport
    Me.Listview1.Gridlines = True
 Listview1.ColumnHeaders.Clear
 Me.Listview1.ColumnHeaders.Add , , "", 0
    Me.Listview1.ColumnHeaders.Add , , "OS", 60, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "DATA", 60, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "HORA", 60, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "CLIENTE", 170, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "FONE1", 80, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "FONE2", 80, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "RAMAL", 80, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "E-MAIL", 125, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "SERVIÇO", 170, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "PROFISSIONAL", 170, LVWCOLUMCENTER
    Me.Listview1.ColumnHeaders.Add , , "DATA_PROX_CONSULTA", 60, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "HORA_PROX_CONSULTA", 60, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "E-MAIL CONFIRMAÇÃO DE CONSULTA", 170, lvwColumnCenter
    Me.Listview1.ColumnHeaders.Add , , "E-MAIL CONFIRMAÇÃO DE RETORNO", 170, lvwColumnCenter
 'Aqui é nossa busca pelo que digitammos
'A busca pode ter qualquer parametro desde que lhe atenda
Dim CADASTRO(1 To 15)

            CADASTRO(1) = UCase(Me.TextFILTROPROF.Text)
            TextFILTROPROF.Text = CADASTRO(1)
            CADASTRO(2) = UCase(Me.Textcliente2.Text)
            Textcliente2.Text = CADASTRO(2)
If TextFILTROPROF.Text = Null Then

MsgBox "CAMPO DE PESQUISA PARA AGENDA: PROFISSIONAL ESTÁ EM BRANCO"
End If
If TextBOXFILTRO.Text = Null Then
MsgBox "CAMPO DE PESQUISA PARA AGENDA: DATA ESTÁ EM BRANCO"
End If
SQL = "SELECT OS,NOME,DATA,HORA,TELRES,TELCEL,TELCOM,RAMAL,EMAIL,SERVICO,PROFISSIONAL,DATA_PROX_AGENDAMENTO,HORA_PROX_AGENDAMENTO,OBSERVACAO,PRONTUARIO FROM [AGENDAMENTO]"
    SQL = SQL & " WHERE [DATA] = '" & TextBOXFILTRO & "'  OR [DATA_PROX_AGENDAMENTO]='" & TextBOXFILTRO & "'"
    SQL = SQL & " AND [PROFISSIONAL]= '" & TextFILTROPROF & "'"
    
    'sql2 = "SELECT OS,NOME,DATA,HORA,TELRES,TELCEL,TELCOM,RAMAL,EMAIL,SERVICO,PROFISSIONAL,DATA_PROX_AGENDAMENTO,HORA_PROX_AGENDAMENTO,OBSERVACAO,PRONTUARIO FROM [AGENDAMENTO]"
    'sql2 = sql2 & " WHERE [DATA_PROX_AGENDAMENTO] = '" & TextBOXFILTRO & "'"
    'sql2 = sql2 & " AND [PROFISSIONAL]= '" & TextFILTROPROF & "'"
    
    Set BANCO = New ADODB.Recordset
    
    BANCO.Open SQL, nConn
   i = 1
   'banco1.Open sq2, nConn2
   
   Count = BANCO1.RecordCount
   BANCO1.MoveFirst
       
While Not BANCO.EOF
If TextFILTROPROF <> "" And TextBOXFILTRO <> "" And Textcliente2 = "" Then
Set LI = Listview1.ListItems.Add(Text:=BANCO("OS"))
If BANCO("os") <> "" Then


LI.ListSubItems.Add Text:=BANCO("OS")


End If

If BANCO("data") <> "" Then

LI.ListSubItems.Add Text:=BANCO("DATA")

End If
If BANCO("hora") <> "" Then

LI.ListSubItems.Add Text:=BANCO("HORA")

End If
If BANCO("nome") <> "" Then


LI.ListSubItems.Add Text:=BANCO("NOME")

End If
If BANCO("FONE1") <> "" Then

LI.ListSubItems.Add Text:=BANCO("FONE1")

End If
If BANCO("FONE2") <> "" Then

LI.ListSubItems.Add Text:=BANCO("FONE2")

End If
If BANCO("ramal") <> "" Then

LI.ListSubItems.Add Text:=BANCO("RAMAL")

End If
If BANCO("email") <> "" Then

LI.ListSubItems.Add Text:=BANCO("EMAIL")

End If
If BANCO("servico") <> "" Then

LI.ListSubItems.Add Text:=BANCO("SERVICO")

End If
If BANCO("profissional") <> "" Then

LI.ListSubItems.Add Text:=BANCO("profissional")

End If
If BANCO("data_prox_agendamento") <> "" Then

LI.ListSubItems.Add Text:=BANCO("data_prox_agendamento")

End If
If BANCO("hora_prox_agendamento") <> "" Then

LI.ListSubItems.Add Text:=BANCO("hora_prox_agendamento")

End If
If BANCO("CONSULTA") <> "" Then

LI.ListSubItems.Add Text:=BANCO("CONSULTA")

End If
If BANCO("RETORNO") <> "" Then

LI.ListSubItems.Add Text:=BANCO("RETORNO")

End If


Dim item As ListItem
 

'Aqui estamos acessando e definindo cada subitem

'Define o formato de visao como Report
Listview1.View = lvwReport



i = i + 1
BANCO.MoveNext

    


 

'Aqui estamos acessando e definindo cada subitem

'Define o formato de visao como Report
Listview1.View = lvwReport



i = i + 1
BANCO1.MoveNext

    
    
    
    
    nConn.Close
    Set BANCO = Nothing
    Exit Sub
erro:
    MsgBox Err.Description
    nConn.Close
    Set BANCO = Nothing
End If
Call TiraAcento2(linha)
Wend
While Not BANCO1.EOF
If TextFILTROPROF = "" And TextBOXFILTRO = "" And Textcliente2 = BANCO1("NOME") Then
Set LI = Listview1.ListItems.Add(Text:=BANCO1("OS"))
If BANCO1("os") <> "" Then


LI.ListSubItems.Add Text:=BANCO1("OS")


End If

If BANCO1("data") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("DATA")

End If
If BANCO1("hora") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("HORA")

End If
If BANCO1("nome") <> "" Then


LI.ListSubItems.Add Text:=BANCO1("NOME")

End If
If BANCO1("FONE1") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("FONE1")

End If
If BANCO1("FONE2") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("FONE2")

End If
If BANCO1("ramal") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("RAMAL")

End If
If BANCO1("email") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("EMAIL")

End If
If BANCO1("servico") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("SERVICO")

End If
If BANCO1("profissional") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("profissional")

End If
If BANCO1("data_prox_agendamento") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("data_prox_agendamento")

End If
If BANCO1("hora_prox_agendamento") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("hora_prox_agendamento")

End If
If BANCO1("CONSULTA") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("CONSULTA")

End If
If BANCO1("RETORNO") <> "" Then

LI.ListSubItems.Add Text:=BANCO1("RETORNO")

End If
End If
BANCO1.MoveNext
Wend
CommandButton4.Enabled = False
CommandButton5.Enabled = False
CommandButton6.Enabled = False
CommandButton7.Enabled = False
CommandButton12.Enabled = False

End Sub

rafaelsetti · Mensagem por **rafaelsetti** » Dom Mar 29, 2015 4:45 pm

Adicione as referencias microsoft access 12.0 object library e microsoft dao 3.6 object library.

afbergman · Mensagem por **afbergman** » Ter Mar 31, 2015 6:51 pm

Rafael,

Esses codigos eu coloco dentro do vba do excel?
O banco de dados que eu criaria no acess, é isso?

Vc pode me mandar o exemplo do seu programa e do seu bd para eu dar uma olhada e adapta-lo?
Acho que eu vendo a coisa funcionando entendo melhor.

Abraços.

rafaelsetti · Mensagem por **rafaelsetti** » Ter Mar 31, 2015 7:30 pm

Segue arquivo excel, mais banco de dados, coloquei o nome de cliente como RAFAEL.

ai é só vc estudar o código.

Obrigado,

Rafael

rafaelsetti · Mensagem por **rafaelsetti** » Ter Mar 31, 2015 10:10 pm

Esqueci de avisar VC tem que alterar no código o caminho do banco de dados para a sua rede ou seu c: obrigado,
Rafael

rafaelsetti · Mensagem por **rafaelsetti** » Ter Mar 31, 2015 10:11 pm

Esqueci de avisar VC tem que alterar no código o caminho do banco de dados para a sua rede ou seu c: obrigado,
Rafael

rafaelsetti · Mensagem por **rafaelsetti** » Ter Mar 31, 2015 10:17 pm

Boa noite,

Esqueci de avisar na mensagem anterior, para funcionar o código, vc precisar alterar no código em cada botão de alterar, incluir, excluir, consultar e relatórios e gravar pdf o caminho do banco de dados e pasta de arquivos que vc deve criar no seu servidor e compartilhar no código tem os nomes corretos.

ao invés de "\\servidor\realfeet\...." vc altera "\\suarede\pastacompartilhada\database\bd.mdb"

ok.

Obrigado,

Rafael

Subscrever linha

Subscrever linha

Re: Subscrever linha

Re: Subscrever linha

Re: Subscrever linha

Re: Subscrever linha

Re: Subscrever linha

Re: Subscrever linha

Re: Subscrever linha

Re: Subscrever linha

Re: Subscrever linha