Esqueceu sua senha? Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Ajuda Conexão VBA com Bando Access

Discussões sobre a integração do Excel com o Banco de Dados Access

Moderador: joseA

Avatar do usuário
Guedelha
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Dom Jul 08, 2018 5:02 pm

Ajuda Conexão VBA com Bando Access

Mensagem por Guedelha » Dom Jul 08, 2018 5:49 pm

Prezados,

Sou um novato na linguagem VBA, e estou adequando cadastro com bando de dados Access.
Contudo apesar de inúmeras pesquisas e tentativas não consigo corrigir o erro abaixo.
Será que alguém pode me ajudar?

Erro em tempo de execução '-2147352571 (80020005)':
Não foi possível definir a propriedade Value. Tipo não corresponde.


Aqui esta os códigos:

FORMULÁRIO VBA DE CADASTRO

Código: Selecionar todos

Option Explicit
Const corDisabledTextBox As Long = -2147483633
Const corEnabledTextBox As Long = -2147483643
Public Indice As Long
Public cx As New ClasseConexao
Public banco As ADODB.Recordset
Public sql As String


Sub Incluir_Registro()

    sql = "INSERT INTO Clientes(DatCadastro, Atividade, Cliente, PF, PJ, RazaoSocial, NomeFantasia, Endereço, Bairro, UF, Cidade, CEP, DDD, Telefone, Celular, CnpjCpf, InscEstadualRG, Contato, Email, Observaçoes)"
    sql = sql & " VALUES ("
    sql = sql & " '" & Me.txtDatCadastro.Value & "'"
    sql = sql & " '" & Me.cboAtividade.Value & "'"
    sql = sql & " '" & Me.cboCliente.Value & "'"
    sql = sql & " '" & Me.cboPF.Value & "'"
    sql = sql & " '" & Me.cboPJ.Value & "'"
    sql = sql & " '" & Me.txtRazaoSocial.Value & "'"
    sql = sql & " '" & Me.txtNomeFantasia.Value & "'"
    sql = sql & " '" & Me.txtEndereço.Value & "'"
    sql = sql & " '" & Me.txtBairro.Value & "'"
    sql = sql & " '" & Me.cboUF.Value & "'"
    sql = sql & " '" & Me.cboCidade.Value & "'"
    sql = sql & " '" & Me.txtCep.Value & "'"
    sql = sql & " '" & Me.txtDDD.Value & "'"
    sql = sql & " '" & Me.txtTelefone.Value & "'"
    sql = sql & " '" & Me.txtCelular.Value & "'"
    sql = sql & " '" & Me.txtCnpjCpf.Value & "'"
    sql = sql & " '" & Me.txtInscEstadualRG.Value & "'"
    sql = sql & " '" & Me.txtContato.Value & "'"
    sql = sql & " '" & Me.txtEmail.Value & "'"
    sql = sql & " '" & Me.txtObservaçoes.Value & "'"
    sql = sql & " )"

    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn
    
    MsgBox "Cadastro efetuado com sucesso.", vbInformation, "Cadastro de Clientes"
    Set banco = Nothing
    cx.Desconectar
    
End Sub
Sub Alterar_Registro()

    'O registro a ser alterado nao pode conter aspas simples

    sql = "UPDATE clientes"
    sql = sql & " SET cliente = '" & Me.txtRazaoSocial & "'"
    sql = sql & ", Atividade = '" & Me.cboAtividade & "'"
    sql = sql & ", PF = '" & Me.cboPF & "'"
    sql = sql & ", PJ = '" & Me.cboPJ & "'"
    sql = sql & ", RazaoSocial = '" & Me.txtRazaoSocial & "'"
    sql = sql & ", NomeFantasia = '" & Me.txtNomeFantasia & "'"
    sql = sql & ", Endereço = '" & Me.txtEndereço & "'"
    sql = sql & ", Bairro = '" & Me.txtBairro & "'"
    sql = sql & ", UF = '" & Me.cboUF & "'"
    sql = sql & ", Cidade = '" & Me.cboCidade & "'"
    sql = sql & ", CEP = '" & Me.txtCep & "'"
    sql = sql & ", DDD = '" & Me.txtDDD & "'"
    sql = sql & ", Telefone = '" & Me.txtTelefone & "'"
    sql = sql & ", Celular = '" & Me.txtCelular & "'"
    sql = sql & ", CnpjCpf = '" & Me.txtCnpjCpf & "'"
    sql = sql & ", InscEstadualRG = '" & Me.txtInscEstadualRG & "'"
    sql = sql & ", Contato = '" & Me.txtContato & "'"
    sql = sql & ", Email = '" & Me.txtEmail & "'"
    sql = sql & ", Observaçoes = '" & Me.txtObservaçoes & "'"


    Set banco = New ADODB.Recordset
    cx.Conectar
    
    banco.Open sql, cx.Conn
    
    MsgBox "Alterado com sucesso.", vbInformation, "Cadastro de Fornecedores"
    Set banco = Nothing
    cx.Desconectar

End Sub

Private Sub btnCancelar_Click()
    
    btnOK.Enabled = False
    btnCancelar.Enabled = False
    UserForm_Initialize
    Call DesabilitaControles
    Call HabilitaBotoesAlteracao
    Call HabilitaBotoesNavegaçao
    lblMensagem.Caption = Empty
    
End Sub

Private Sub btnOK_Click()
    
    'Altera
    If optAlterar.Value Then
        Call Alterar_Registro
        lblMensagem.Caption = "Registro salvo com sucesso."
        
    End If
    
    'Novo
    If optNovo.Value Then
        Call Incluir_Registro
        btnUltimo_Click
        lblMensagem.Caption = "Registro salvo com sucesso."
    End If
    
    'Excluir
    If optExcluir.Value Then
        Dim result As VbMsgBoxResult
        result = MsgBox("Deseja excluir o cliente: " & Me.txtRazaoSocial & " ?", vbYesNo, "Confirmação")

        If result = vbYes Then
            sql = "DELETE FROM clientes"
            sql = sql & " WHERE codigo =  " & Me.txtID.Value
            Set banco = New ADODB.Recordset
            cx.Conectar
            banco.Open sql, cx.Conn
            Set banco = Nothing
            cx.Desconectar
            UserForm_Initialize
            lblMensagem.Caption = "Registro excluído com sucesso."
        Else
            btnCancelar_Click
        End If
    End If

    Call HabilitaBotoesAlteracao
    Call DesabilitaControles
    Call HabilitaBotoesNavegaçao
    
End Sub

Private Sub optAlterar_Click()
    
    If txtID.Text <> vbNullString And txtID.Text <> "" Then
        Call HabilitaControles
        Call DesabilitaBotoesAlteracao
        Call DesabilitaBotoesNavegaçao
        'dá o foco ao primeiro controle de dados
        txtRazaoSocial.SetFocus
    Else
        lblMensagem.Caption = "Não há registro a ser alterado"
    End If
    
End Sub

Private Sub optExcluir_Click()

    If txtID.Text <> vbNullString And txtID.Text <> "" Then
        Call DesabilitaBotoesAlteracao
        lblMensagem.Caption = "Modo de exclusão. Confira o dados do registro antes de excluí-lo."
    Else
        lblMensagem.Caption = "Não há registro a ser excluído."
    End If
End Sub

Private Sub optNovo_Click()
    Call LimpaControles
    Call DesabilitaBotoesAlteracao
    Call DesabilitaBotoesNavegaçao
    Call HabilitaControles
    Me.txtRazaoSocial.SetFocus
End Sub
Sub CarregaRegistros()

     With banco
      If Not IsNull(.Fields(0)) Then
        Me.txtID.Value = .Fields(0)
        Me.txtDatCadastro.Value = .Fields(1)
        Me.cboAtividade.Value = .Fields(2)
        Me.cboCliente.Value = .Fields(3)
        Me.cboPF.Value = .Fields(4)
        Me.cboPJ.Value = .Fields(5)
        Me.txtRazaoSocial.Value = .Fields(6)
        Me.txtNomeFantasia.Value = .Fields(7)
        Me.txtEndereço.Value = .Fields(8)
        Me.txtBairro.Value = .Fields(9)
        Me.cboUF.Value = .Fields(10)
        Me.cboCidade.Value = .Fields(11)
        Me.txtCep.Value = .Fields(12)
        Me.txtDDD.Value = .Fields(13)
        Me.txtTelefone.Value = .Fields(14)
        Me.txtCelular.Value = .Fields(15)
        Me.txtCnpjCpf.Value = .Fields(16)
        Me.txtInscEstadualRG.Value = .Fields(17)
        Me.txtContato.Value = .Fields(18)
        Me.txtEmail.Value = .Fields(19)
        Me.txtObservaçoes.Value = .Fields(20)
      End If
    
    End With
    lblIndice.Caption = Indice
    lblTotal.Caption = banco.RecordCount
    
End Sub

Private Sub btnAnterior_Click()
   
   On Error GoTo final
   
    sql = "SELECT ID, DatCadastro, Atividade, Cliente, PF, PJ, RazaoSocial, NomeFantasia, Endereço, Bairro, UF, Cidade, CEP, DDD, Telefone, Celular, CnpjCpf, InscEstadualRG, Contato, Email, Observaçoes FROM Clientes "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    
    banco.AbsolutePosition = Indice - 1
    Indice = banco.AbsolutePosition
    
    Call CarregaRegistros
    
final:
    Set banco = Nothing
    cx.Desconectar
    
End Sub

Private Sub btnPesquisar_Click()
    CliPesquisa.Show
End Sub

Private Sub btnPrimeiro_Click()
    
   On Error GoTo final
   
    sql = "SELECT id, DatCadastro, Atividade, Cliente, PF, PJ, RazaoSocial, NomeFantasia, Endereço, Bairro, UF, Cidade, CEP, DDD, Telefone, Celular, CnpjCpf, InscEstadualRG, Contato, Email, Observaçoes FROM Clientes "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    
    banco.AbsolutePosition = 1
    Indice = banco.AbsolutePosition
    
     Call CarregaRegistros
final:
    Set banco = Nothing
    cx.Desconectar

End Sub

Private Sub btnProximo_Click()

  On Error Resume Next
   
    sql = "SELECT id, DatCadastro, Atividade, Cliente, PF, PJ, RazaoSocial, NomeFantasia, Endereço, Bairro, UF, Cidade, CEP, DDD, Telefone, Celular, CnpjCpf, InscEstadualRG, Contato, Email, Observaçoes FROM Clientes "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    
   If lblIndice.Caption <> lblTotal.Caption Then
   
    banco.AbsolutePosition = Indice + 1
    Indice = banco.AbsolutePosition
   
    Call CarregaRegistros
     
   End If

    Set banco = Nothing
    cx.Desconectar
    Exit Sub
    
End Sub

Private Sub btnUltimo_Click()
  
   On Error GoTo final
   
    sql = "SELECT id, DatCadastro, Atividade, Cliente, PF, PJ, RazaoSocial, NomeFantasia, Endereço, Bairro, UF, Cidade, CEP, DDD, Telefone, Celular, CnpjCpf, InscEstadualRG, Contato, Email, Observaçoes FROM Clientes "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    
    banco.AbsolutePosition = banco.RecordCount
    Indice = banco.AbsolutePosition
    
     Call CarregaRegistros
    
final:
    Set banco = Nothing
    cx.Desconectar

End Sub

Private Sub UserForm_Initialize()
 
    sql = "SELECT ID, DatCadastro, Atividade, Cliente, PF, PJ, RazaoSocial, NomeFantasia, Endereço, Bairro, UF, Cidade, CEP, DDD, Telefone, Celular, CnpjCpf, InscEstadualRG, Contato, Email, Observaçoes FROM Clientes "
    Set banco = New ADODB.Recordset
    cx.Conectar
    banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
    
    Indice = banco.AbsolutePosition
    
    Call CarregaRegistros
     
    Call DesabilitaControles
    Call HabilitaBotoesAlteracao
    
    Set banco = Nothing
    cx.Desconectar
    
End Sub

Private Sub LimpaControles()
    Me.txtID.Text = ""
    Me.txtDatCadastro.Text = ""
    Me.cboAtividade.Text = ""
    Me.cboCliente.Text = ""
    Me.cboPF.Text = ""
    Me.cboPJ.Text = ""
    Me.txtRazaoSocial.Text = ""
    Me.txtNomeFantasia.Text = ""
    Me.txtEndereço.Text = ""
    Me.txtBairro.Text = ""
    Me.cboUF.Text = ""
    Me.cboCidade.Text = ""
    Me.txtCep.Text = ""
    Me.txtDDD.Text = ""
    Me.txtTelefone.Text = ""
    Me.txtCelular.Text = ""
    Me.txtCnpjCpf.Text = ""
    Me.txtInscEstadualRG.Text = ""
    Me.txtContato.Text = ""
    Me.txtEmail.Text = ""
    Me.txtObservaçoes.Text = ""
End Sub

Private Sub HabilitaControles()

   'Me.txtID.Locked = False
    Me.txtDatCadastro.Locked = False
    Me.cboAtividade.Locked = False
    Me.cboCliente.Locked = False
    Me.cboPF.Locked = False
    Me.cboPJ.Locked = False
    Me.txtRazaoSocial.Locked = False
    Me.txtNomeFantasia.Locked = False
    Me.txtEndereço.Locked = False
    Me.txtBairro.Locked = False
    Me.cboUF.Locked = False
    Me.cboCidade.Locked = False
    Me.txtCep.Locked = False
    Me.txtDDD.Locked = False
    Me.txtTelefone.Locked = False
    Me.txtCelular.Locked = False
    Me.txtCnpjCpf.Locked = False
    Me.txtInscEstadualRG.Locked = False
    Me.txtContato.Locked = False
    Me.txtEmail.Locked = False
    Me.txtObservaçoes.Locked = False

    Me.txtDatCadastro.BackColor = corEnabledTextBox
    Me.cboAtividade.BackColor = corEnabledTextBox
    Me.cboCliente.BackColor = corEnabledTextBox
    Me.cboPF.BackColor = corEnabledTextBox
    Me.cboPJ.BackColor = corEnabledTextBox
    Me.txtRazaoSocial.BackColor = corEnabledTextBox
    Me.txtNomeFantasia.BackColor = corEnabledTextBox
    Me.txtEndereço.BackColor = corEnabledTextBox
    Me.txtBairro.BackColor = corEnabledTextBox
    Me.cboUF.BackColor = corEnabledTextBox
    Me.cboCidade.BackColor = corEnabledTextBox
    Me.txtCep.BackColor = corEnabledTextBox
    Me.txtDDD.BackColor = corEnabledTextBox
    Me.txtTelefone.BackColor = corEnabledTextBox
    Me.txtCelular.BackColor = corEnabledTextBox
    Me.txtCnpjCpf.BackColor = corEnabledTextBox
    Me.txtInscEstadualRG.BackColor = corEnabledTextBox
    Me.txtContato.BackColor = corEnabledTextBox
    Me.txtEmail.BackColor = corEnabledTextBox
    Me.txtObservaçoes.BackColor = corEnabledTextBox

End Sub

Private Sub DesabilitaControles()

Me.txtID.Locked = True
    Me.txtDatCadastro.Locked = True
    Me.cboAtividade.Locked = True
    Me.cboCliente.Locked = True
    Me.cboPF.Locked = True
    Me.cboPJ.Locked = True
    Me.txtRazaoSocial.Locked = True
    Me.txtNomeFantasia.Locked = True
    Me.txtEndereço.Locked = True
    Me.txtBairro.Locked = True
    Me.cboUF.Locked = True
    Me.cboCidade.Locked = True
    Me.txtCep.Locked = True
    Me.txtDDD.Locked = True
    Me.txtTelefone.Locked = True
    Me.txtCelular.Locked = True
    Me.txtCnpjCpf.Locked = True
    Me.txtInscEstadualRG.Locked = True
    Me.txtContato.Locked = True
    Me.txtEmail.Locked = True
    Me.txtObservaçoes.Locked = True

    Me.txtDatCadastro.BackColor = corDisabledTextBox
    Me.cboAtividade.BackColor = corDisabledTextBox
    Me.cboCliente.BackColor = corDisabledTextBox
    Me.cboPF.BackColor = corDisabledTextBox
    Me.cboPJ.BackColor = corDisabledTextBox
    Me.txtRazaoSocial.BackColor = corDisabledTextBox
    Me.txtNomeFantasia.BackColor = corDisabledTextBox
    Me.txtEndereço.BackColor = corDisabledTextBox
    Me.txtBairro.BackColor = corDisabledTextBox
    Me.cboUF.BackColor = corDisabledTextBox
    Me.cboCidade.BackColor = corDisabledTextBox
    Me.txtCep.BackColor = corDisabledTextBox
    Me.txtDDD.BackColor = corDisabledTextBox
    Me.txtTelefone.BackColor = corDisabledTextBox
    Me.txtCelular.BackColor = corDisabledTextBox
    Me.txtCnpjCpf.BackColor = corDisabledTextBox
    Me.txtInscEstadualRG.BackColor = corDisabledTextBox
    Me.txtContato.BackColor = corDisabledTextBox
    Me.txtEmail.BackColor = corDisabledTextBox
    Me.txtObservaçoes.BackColor = corDisabledTextBox
End Sub

Private Sub HabilitaBotoesAlteracao()
'habilita os botões de alteração
    optAlterar.Enabled = True
    optExcluir.Enabled = True
    optNovo.Enabled = True
    btnPesquisar.Enabled = True
    btnOK.Enabled = False
    btnCancelar.Enabled = False

    'limpa os valores dos controles
    optAlterar.Value = False
    optExcluir.Value = False
    optNovo.Value = False
End Sub

Private Sub DesabilitaBotoesAlteracao()
'desabilita os botões de alteração
    optAlterar.Enabled = False
    optExcluir.Enabled = False
    optNovo.Enabled = False
    btnPesquisar.Enabled = False
    btnOK.Enabled = True
    btnCancelar.Enabled = True
End Sub

Private Sub HabilitaBotoesNavegaçao()
    
    btnPrimeiro.Enabled = True
    btnAnterior.Enabled = True
    btnProximo.Enabled = True
    btnUltimo.Enabled = True
End Sub

Private Sub DesabilitaBotoesNavegaçao()
    
    btnPrimeiro.Enabled = False
    btnAnterior.Enabled = False
    btnProximo.Enabled = False
    btnUltimo.Enabled = False
    
End Sub

Private Sub btnSair_Click()
    Unload Me
End Sub

FORMULÁRIO VBA PARA PESQUISA

Public ProcurarPor As String
Public OrdenarPor As String
Public Ordem As String

Sub cboOrdem_Change()
    
    Select Case cboOrdem.ListIndex
        Case 0
            Ordem = "DESC"
        Case 1
            Ordem = "ASC"
    End Select
    txtPesquisa_Change
    
End Sub

Private Sub cboOrdenarPor_Change()

    txtPesquisa_Change
    
End Sub

Private Sub chkPesquisa_Click()
    txtPesquisa_Change
End Sub

Private Sub lstv_Dblclick()
   
    With CliCadastro
        .sql = "SELECT ID, DatCadastro, Atividade, Cliente, PF, PJ, RazaoSocial, NomeFantasia, Endereço, Bairro, UF, Cidade, CEP, DDD, Telefone, Celular, CnpjCpf, InscEstadualRG, Contato, Email, Observaçoes FROM Clientes "
        .sql = .sql & " WHERE codigo = " & lstv.SelectedItem
        Set .banco = New ADODB.Recordset
        .cx.Conectar
        .banco.Open .sql, .cx.Conn, adOpenKeyset, adLockOptimistic
        
        Call .CarregaRegistros
        .Indice = Id
        .lblIndice.Caption = Id
        .lblTotal.Caption = Total
        
    Set .banco = Nothing
    .cx.Desconectar
    
    End With
    Unload Me
    
End Sub

Private Sub lstv_KeyPress(KeyAscii As Integer)
    
    lstv_Dblclick
    
End Sub

Private Sub txtPesquisa_Change()
    
    Dim cx As New ClasseConexao
    Dim banco As ADODB.Recordset
    Dim sql As String
    
    ProcurarPor = Me.cboPesquisarPor.Text
    OrdenarPor = Me.cboOrdenarPor.Text
    
    With Me.lstv
        .ListItems.Clear
        
        sql = "SELECT ID, DatCadastro, Atividade, Cliente, PF, PJ, RazaoSocial, NomeFantasia, Endereço, Bairro, UF, Cidade, CEP, DDD, Telefone, Celular, CnpjCpf, InscEstadualRG, Contato, Email, Observaçoes FROM Clientes "
        
        If Me.chkPesquisa.Value = True Then
            sql = sql & " WHERE " & ProcurarPor & " LIKE '%" & Me.txtPesquisa.Value & "%' ORDER BY " & OrdenarPor & " " & Ordem
        
        ElseIf Me.chkPesquisa.Value = False Then
            sql = sql & " WHERE " & ProcurarPor & " LIKE '" & Me.txtPesquisa.Value & "%' ORDER BY " & OrdenarPor & " " & Ordem
        End If
        
        Set banco = New ADODB.Recordset
        cx.Conectar
        
        banco.Open sql, cx.Conn, adOpenKeyset, adLockOptimistic
        
        Dim i As Integer
        For i = 0 To banco.RecordCount - 1
            If Not IsNull(banco(0)) Then
                .ListItems.Add 1, , banco(0)
                .ListItems(1).ListSubItems.Add 1, , banco(1)
                .ListItems(1).ListSubItems.Add 2, , banco(2)
                .ListItems(1).ListSubItems.Add 3, , banco(3)
                .ListItems(1).ListSubItems.Add 4, , banco(4)
                .ListItems(1).ListSubItems.Add 5, , banco(5)
                .ListItems(1).ListSubItems.Add 6, , banco(6)
                .ListItems(1).ListSubItems.Add 7, , banco(7)
                .ListItems(1).ListSubItems.Add 8, , banco(8)
                .ListItems(1).ListSubItems.Add 9, , banco(9)
                .ListItems(1).ListSubItems.Add 10, , banco(10)
                .ListItems(1).ListSubItems.Add 11, , banco(11)
                .ListItems(1).ListSubItems.Add 12, , banco(12)
                .ListItems(1).ListSubItems.Add 13, , banco(13)
                .ListItems(1).ListSubItems.Add 14, , banco(14)
                .ListItems(1).ListSubItems.Add 15, , banco(15)
                .ListItems(1).ListSubItems.Add 16, , banco(16)
                .ListItems(1).ListSubItems.Add 17, , banco(17)
                .ListItems(1).ListSubItems.Add 18, , banco(18)
                .ListItems(1).ListSubItems.Add 19, , banco(19)
                .ListItems(1).ListSubItems.Add 20, , banco(20)

            End If
            banco.MoveNext
        Next i
        Set banco = Nothing
        cx.Desconectar
    End With
    
    Me.StatusBar1.Panels(1).Text = "Total de Itens Localizados: " & Me.lstv.ListItems.Count
    
End Sub

Private Sub UserForm_Initialize()

    With cboPesquisarPor
        .AddItem "ID"
        .AddItem "DatCadastro"
        .AddItem "Atividade"
        .AddItem "Cliente"
        .AddItem "PF"
        .AddItem "PJ"
        .AddItem "RazaoSocial"
        .AddItem "NomeFantasia"
        .AddItem "Endereço"
        .AddItem "Bairro"
        .AddItem "UF"
        .AddItem "Cidade"
        .AddItem "Cep"
        .AddItem "DDD"
        .AddItem "Telefone"
        .AddItem "Celular"
        .AddItem "CnpjCpf"
        .AddItem "InscEstadualRG"
        .AddItem "Contato"
        .AddItem "Email"
        .AddItem "Observaçoes"
        .ListIndex = 1
    End With
    
    cboOrdenarPor.List = cboPesquisarPor.List
    cboOrdenarPor.ListIndex = 0
    With cboOrdem
        .AddItem "Crescente"
        .AddItem "Descrescente"
        .ListIndex = 0
    End With
    
    With Me.lstv
        
        .FullRowSelect = True
        .View = lvwReport
        .Gridlines = True
        .Font.Size = 10
        
        .ColumnHeaders.Add Text:="ID", Width:=50
        .ColumnHeaders.Add Text:="DatCadastro", Width:=70
        .ColumnHeaders.Add Text:="Atividade", Width:=100
        .ColumnHeaders.Add Text:="Cliente", Width:=50
        .ColumnHeaders.Add Text:="PF", Width:=40
        .ColumnHeaders.Add Text:="PJ", Width:=40
        .ColumnHeaders.Add Text:="RazaoSocial", Width:=180
        .ColumnHeaders.Add Text:="NomeFantasia", Width:=100
        .ColumnHeaders.Add Text:="Endereço", Width:=150
        .ColumnHeaders.Add Text:="Bairro", Width:=100
        .ColumnHeaders.Add Text:="UF", Width:=30
        .ColumnHeaders.Add Text:="Cidade", Width:=100
        .ColumnHeaders.Add Text:="CEP", Width:=50
        .ColumnHeaders.Add Text:="DDD", Width:=30
        .ColumnHeaders.Add Text:="Telefone", Width:=80
        .ColumnHeaders.Add Text:="Celular", Width:=80
        .ColumnHeaders.Add Text:="CnpjCpf", Width:=100
        .ColumnHeaders.Add Text:="InscEstadualRG", Width:=100
        .ColumnHeaders.Add Text:="Contato", Width:=100
        .ColumnHeaders.Add Text:="Email", Width:=120
        .ColumnHeaders.Add Text:="Observaçoes", Width:=150

    End With
    
    Me.StatusBar1.Panels(1).Text = "Total de Itens Localizados: " & Me.lstv.ListItems.Count
    
End Sub
Fico muito grato pela ajuda.

Abçs. e Deus no controle.



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1080
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Bragança Paulista - SP

Re: Ajuda Conexão VBA com Bando Access

Mensagem por Mikel Silveira Fraga » Seg Jul 09, 2018 1:47 am

Guedelha, bom dia e seja bem vindo ao fórum.

Vou deixar uma dica pra você sobre solicitação de ajuda. Quando se tem um código tão extenso e complexo, como o que você acabou de deixar, o ideal é enviar o modelo para realização dos testes.

Pelo que percebi, você enviou o código apenas do formulário, sendo que o erro pode estar sendo causado por outra parte do projeto, ou até mesmo, pelo banco de dados.

Para conseguir uma ajuda mais eficaz na resolução do seu problema, aconselho enviar o modelo do Excel e do Access que esta construindo, portando informações fictícias.

Tenha uma excelente semana e fique com Deus.


Gostou da dica? Clique no JOIA no topo da mensagem.
Esclareceu suas dúvidas? Acrescente ao título do tópico a expressão: [RESOLVIDO].
Orientações sobre o fórum, acesse aqui.

Mikel Silveira Fraga
E-mail: mikel-sf@hotmail.com | Skype: mikelsf | Linked In

Responder