Boa tarde amigos, estou com este problema de Erro de tempo de execução (80020005) Tipo não correspondente.
Alguém pode ajudar-me?
Segue anexo... Forte Abraço
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Erro de tempo de execução (80020005)
Moderador: joseA
Re: Erro de tempo de execução (80020005)
Boa noite amigo,
quando seleciona o orçamento e tenta salvar ele aparece o erro...
Private Sub btnGravar_Click()
'On Error Resume Next
If Me.txtNome = Empty Then
MsgBox "Digite o nome do cliente.", vbExclamation, "Atenção"
Exit Sub
End If
If Not Me.lstvOrç.ListItems.Count > 0 Then
MsgBox "É necessário incluir pelo menos um " & Chr(13) & "item para salvar o orçamento.", vbExclamation, "Erro"
Me.txtQtde.SetFocus
Exit Sub
End If
If Inc = True Then
rsOrçDet.AddNew
Else
rsOrçGrad.Close
SqlOrçGrad = "DELETE FROM tbOrçamento_Grade WHERE Nro_Orçamento = " & NroOrç 'Apaga os registros antigos
rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic 'pra incluir os dados atualizados
SqlOrçGrad = "SELECT * FROM tbOrçamento_Grade"
rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic
End If
rsOrçDet(1) = Date
rsOrçDet(2) = Me.txtNome
rsOrçDet(4) = CDbl(Me.txtTotal) 'Total líquido
rsOrçDet(5) = Me.txtObservaçoes
rsOrçDet(6) = Me.txtTelefone
rsOrçDet(7) = Me.txt_contato
rsOrçDet(8) = Me.txt_email
rsOrçDet(9) = Me.txt_endereço
rsOrçDet(10) = Me.txt_cnpj_cpf
rsOrçDet(11) = Me.txt_ie
rsOrçDet(12) = Me.txt_numero
rsOrçDet(13) = Me.txt_bairro
rsOrçDet(14) = Me.txt_cep
rsOrçDet(15) = Me.txt_cidade
rsOrçDet(16) = Me.txt_uf
rsOrçDet.Update
For i = 1 To Me.lstvOrç.ListItems.Count
With Me.lstvOrç
rsOrçGrad.AddNew
rsOrçGrad(0) = NroOrç
rsOrçGrad(1) = .ListItems(i) 'Código do Produto
rsOrçGrad(2) = .ListItems(i).ListSubItems(1) 'Descrição do Produto
rsOrçGrad(3) = CDbl(.ListItems(i).ListSubItems(2)) 'Qtde
rsOrçGrad(4) = .ListItems(i).ListSubItems(3) 'Unidade de Medida ''''erro nesta parte!!!!!!
rsOrçGrad(5) = CDbl(.ListItems(i).ListSubItems(4)) 'Valor Unitário
rsOrçGrad(6) = CDbl(.ListItems(i).ListSubItems(5)) 'Valor Total
rsOrçGrad.Update
End With
Next i
If Inc = True Then
rsNro.AddNew
rsNro(0) = NroOrç
rsNro.Update
End If
LimpaControles
rsNro.MoveLast
NroOrç = rsNro(0).Value + 1
Me.stbOrç.Panels(1) = "Nro Orç.: " & NroOrç
iCancel = 0
MsgBox "Orçamento salvo com sucesso.", vbInformation, "Módulo Orçamento 2.0"
Me.btnLer.Enabled = True
Me.txtNome.Enabled = False
Me.txtQtde.Enabled = False
Me.txtProduto.Enabled = False
Me.txtCusUnit.Enabled = False
Me.txtCusTotal.Enabled = False
Me.txt_und_medida.Enabled = False
Me.txtPreUnit_Cod_Produto.Enabled = False
Me.btnGravar.Enabled = False
Me.btnBuscar.Enabled = False
End Sub
quando seleciona o orçamento e tenta salvar ele aparece o erro...
Private Sub btnGravar_Click()
'On Error Resume Next
If Me.txtNome = Empty Then
MsgBox "Digite o nome do cliente.", vbExclamation, "Atenção"
Exit Sub
End If
If Not Me.lstvOrç.ListItems.Count > 0 Then
MsgBox "É necessário incluir pelo menos um " & Chr(13) & "item para salvar o orçamento.", vbExclamation, "Erro"
Me.txtQtde.SetFocus
Exit Sub
End If
If Inc = True Then
rsOrçDet.AddNew
Else
rsOrçGrad.Close
SqlOrçGrad = "DELETE FROM tbOrçamento_Grade WHERE Nro_Orçamento = " & NroOrç 'Apaga os registros antigos
rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic 'pra incluir os dados atualizados
SqlOrçGrad = "SELECT * FROM tbOrçamento_Grade"
rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic
End If
rsOrçDet(1) = Date
rsOrçDet(2) = Me.txtNome
rsOrçDet(4) = CDbl(Me.txtTotal) 'Total líquido
rsOrçDet(5) = Me.txtObservaçoes
rsOrçDet(6) = Me.txtTelefone
rsOrçDet(7) = Me.txt_contato
rsOrçDet(8) = Me.txt_email
rsOrçDet(9) = Me.txt_endereço
rsOrçDet(10) = Me.txt_cnpj_cpf
rsOrçDet(11) = Me.txt_ie
rsOrçDet(12) = Me.txt_numero
rsOrçDet(13) = Me.txt_bairro
rsOrçDet(14) = Me.txt_cep
rsOrçDet(15) = Me.txt_cidade
rsOrçDet(16) = Me.txt_uf
rsOrçDet.Update
For i = 1 To Me.lstvOrç.ListItems.Count
With Me.lstvOrç
rsOrçGrad.AddNew
rsOrçGrad(0) = NroOrç
rsOrçGrad(1) = .ListItems(i) 'Código do Produto
rsOrçGrad(2) = .ListItems(i).ListSubItems(1) 'Descrição do Produto
rsOrçGrad(3) = CDbl(.ListItems(i).ListSubItems(2)) 'Qtde
rsOrçGrad(4) = .ListItems(i).ListSubItems(3) 'Unidade de Medida ''''erro nesta parte!!!!!!
rsOrçGrad(5) = CDbl(.ListItems(i).ListSubItems(4)) 'Valor Unitário
rsOrçGrad(6) = CDbl(.ListItems(i).ListSubItems(5)) 'Valor Total
rsOrçGrad.Update
End With
Next i
If Inc = True Then
rsNro.AddNew
rsNro(0) = NroOrç
rsNro.Update
End If
LimpaControles
rsNro.MoveLast
NroOrç = rsNro(0).Value + 1
Me.stbOrç.Panels(1) = "Nro Orç.: " & NroOrç
iCancel = 0
MsgBox "Orçamento salvo com sucesso.", vbInformation, "Módulo Orçamento 2.0"
Me.btnLer.Enabled = True
Me.txtNome.Enabled = False
Me.txtQtde.Enabled = False
Me.txtProduto.Enabled = False
Me.txtCusUnit.Enabled = False
Me.txtCusTotal.Enabled = False
Me.txt_und_medida.Enabled = False
Me.txtPreUnit_Cod_Produto.Enabled = False
Me.btnGravar.Enabled = False
Me.btnBuscar.Enabled = False
End Sub
Re: Erro de tempo de execução (80020005) [RESOLVIDO]
Boa noite amigos, consegui resolver.... Obrigado pela força...
Fiquem com Deus.
Fiquem com Deus.