se eu quando peço para atualizar uma informação onde usando Código na Sub ATUALIZAR_SALVAR_RECEBER
If F_receber.cod2 = RS(0) Then ele grava uma nova informaão ao invez de atualizar
mas se eu colocar o sinal de diferente ele esta reconhecendo com valor igual.
dessa maneira quando peço para gerar novo recebimento com código novo ele reconhece como código existente mesmo estando vazio ou novo código. e vice verso.. falta pouco para eu concluir e se for pedir muito a formula conte se para contar a repetição de um determinado nome.
Tudo onde estava o
coloquei
dim pesquisa as integer
pesquisa = F_receber.cod2.Value
sql = "SELECT * FROM RECEBER WHERE ID LIKE '" & pesquisa & "'"
e depois If pesquisa = RS(0) Then
resolvido o problema
Código: Selecionar todos
Sub ATUALIZAR_SALVAR_RECEBER()
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
'========salvar_atualizar
Dim resultado As VbMsgBoxResult
sql = "SELECT * FROM RECEBER WHERE ID LIKE '" & F_receber.cod2.Value & "'"
'define a conexão e abre o Recordset com os dados da tabela empresa
Call CONECTADB
'*carrega lista de dados
Set RS = New ADODB.Recordset
RS.Open sql, db, 3, 3
With RS
If F_receber.cod2 <> RS(0) Then
resultado = MsgBox("cadastro existente no Código " & RS(0) & ", deseja atualizar ", vbYesNo, "atualizar")
If resultado = vbYes Then
Call fechadb
Call ATUALIZAR_RECEBER
Exit Sub
End If
Call fechadb
Exit Sub
End If
End With
Call fechadb
'Call SALVAR_RECEBER
'=========fim salvar atualizar
'habilitar novamente
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub SALVAR_RECEBER()
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
Call ID_RECEBER
sql = "SELECT * FROM RECEBER"
'define a conexão e abre o Recordset com os dados da tabela empresa
Call CONECTADB
'*carrega lista de dados
Set RS = New ADODB.Recordset
RS.Open sql, db, 3, 3
On Error Resume Next
'salva
RS.AddNew
RS(0) = F_receber.cod2
RS(3) = F_receber.TEXT2
RS(4) = F_receber.TEXT3
RS(5) = F_receber.TEXT4
RS(6) = F_receber.TEXT5
RS(7) = F_receber.TEXT6
On Error Resume Next
RS(8) = F_receber.TEXT7
RS(9) = F_receber.TEXT8
RS(10) = F_receber.TEXT9
On Error Resume Next
RS(11) = F_receber.TEXT10
RS(12) = F_receber.TEXT11
RS(13) = F_receber.TEXT12
If F_receber.TEXT2 = "Empresa" Then
RS(15) = F_receber.COD3.Value
ElseIf F_receber.TEXT2 = "Paciente" Then
RS(16) = F_receber.COD3.Value
End If
RS(1) = Format(F_receber.TEXT7, "mmmm")
RS(2) = Format(F_receber.TEXT7, "YYYY")
If F_receber.TEXT11 = "0" Then
RS(14) = "Pago"
Else
RS(14) = "Em Aberto"
End If
RS.Update
'desconectar
Call fechadb
MsgBox "Dados Gravados com Sucesso"
'habilitar novamente
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub ATUALIZAR_RECEBER()
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.EnableEvents = False
sql = "SELECT * FROM RECEBER WHERE ID LIKE '" & F_receber.cod2.Value & "'"
'define a conexão e abre o Recordset com os dados da tabela empresa
Call CONECTADB
'*carrega lista de dados
Set RS = New ADODB.Recordset
RS.Open sql, db, 3, 3
'On Error Resume Next
'salva
RS.Update
RS(0) = F_receber.cod2
RS(3) = F_receber.TEXT2
RS(4) = F_receber.TEXT3
RS(5) = F_receber.TEXT4
RS(6) = F_receber.TEXT5
RS(7) = F_receber.TEXT6
On Error Resume Next
RS(8) = F_receber.TEXT7
RS(9) = F_receber.TEXT8
RS(10) = F_receber.TEXT9
On Error Resume Next
RS(11) = F_receber.TEXT10
RS(12) = F_receber.TEXT11
RS(13) = F_receber.TEXT12
If F_receber.TEXT2 = "Empresa" Then
RS(15) = F_receber.COD3.Value
ElseIf F_receber.TEXT2 = "Paciente" Then
RS(16) = F_receber.COD3.Value
End If
RS(1) = Format(F_receber.TEXT7, "mmmm")
RS(2) = Format(F_receber.TEXT7, "YYYY")
If F_receber.TEXT11 = "0" Then
RS(14) = "Pago"
Else
RS(14) = "Em Aberto"
End If
RS.Update
'desconectar
Call fechadb
MsgBox "Dados Gravados com Sucesso"
'habilitar novamente
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub