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
Abçs. e Deus no controle.