Estou tentando adaptar um código, de cadastro de receitas para cadastro de clientes, e decorre que no código anterior não aceita campos nulos para serem inseridos no BD, mas no programa atual de clientes, é necessário que apenas os dois primeiros campos não possam ser nulos, que seriam "nome" e "endereço". Será que alguém sabe como resolver isso. Antecipadamente agradeço. Frata
Estou postando o código abaixo.
'declarando os objetos necessários
'command e recordset para interagir com o BD
'e declarando variavel para utilizar msgbox
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim vinfo As Integer
'chamando a sub que carrega a lista com os dados do BD
Private Sub Form_Load()
preenche_list
End Sub
'descarregando os objetos command e recordset quando
'fechar o form e limpando os arquivos temp criados
Private Sub Form_Unload(Cancel As Integer)
Set cmd = Nothing
Set rs = Nothing
Set cnnreceitas = Nothing
If Dir("c:*.tmp") <> "" Then
On Error Resume Next
Kill "c:*.tmp"
End If
End Sub
'quando der duplo click na lista
'filtra as informações no BD e joga nos campos
'para alterar
Private Sub List_receitas_DblClick()
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select * from receitas"
Set rs = .Execute
End With
With rs
.Filter = " receita like '" & List_receitas.Text & "'"
Frame_cadastro.Visible = True
Frame_Localizar.Visible = False
Toolbar1.Visible = False
Toolbar2.Visible = True
travar_campos
Text_cod = !cod
Text_receita = !receita
Text_ingredientes = !ingredientes
Text_preparo = !preparo
Text_email = !email
End With
End Sub
'codigo que faz a busca na List quando é digitado
'na text
Private Sub Text1_Change()
On Error GoTo trataerro
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select * from receitas"
Set rs = .Execute
End With
With rs
.Filter = " receita like '%" & Text1.Text & "%'"
If .BOF And .EOF Then
MsgBox ("Sequencia de caracteres não encontrado na lista")
Else
List_receitas = rs!receita
End If
End With
trataerro:
With Err
If .Number <> 0 Then
.Number = 0
End If
End With
End Sub
'faz as alterações entre as toolbar e os frames
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
Toolbar1.Visible = False
Toolbar2.Visible = True
Frame_cadastro.Visible = True
Frame_Localizar.Visible = False
Case 2
Frame_Localizar.Visible = True
Text1.Text = ""
End Select
End Sub
'chama os procedimentos de gravar, inserir ou retornar
'para o outro frame
Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
NOVO
Case 2
Gravar
Case 3
If Text_cod.Text <> "" Then
liberar_campos
Else
MsgBox ("Escolha uma receita na lista através do menu Localizar, dê duplo click na receita a ser alterada")
End If
Case 4
excluir
Case 5
Toolbar2.Visible = False
Toolbar1.Visible = True
Frame_cadastro.Visible = False
limpar_campos
preenche_list
End Select
End Sub
'subprocedimento que prepara a inserção de um novo
'registro no BD
Private Sub NOVO()
vinfo = MsgBox("Deseja inserir nova receita no Livro de Receitas ?", vbYesNo + vbQuestion, "Nova receita")
If vinfo = vbYes Then
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select max(cod) as Mcod from receitas"
Set rs = .Execute
End With
With rs
If IsNull(rs!Mcod) Then
Text_cod.Text = 1
Else
limpar_campos
preenche_list
Text_cod.Text = !Mcod + 1
End If
End With
Text_receita.Locked = False
Text_ingredientes.Locked = False
Text_preparo.Locked = False
Text_email.Locked = False
Text_receita.SetFocus
End If
End Sub
'subprocedimento para gravar um registro novo
'ou alterar um registro existente
Private Sub Gravar()
'se houver campos em branco informa ao usuario
If Text_receita.Text = "" Or _
Text_ingredientes.Text = "" Or _
Text_preparo.Text = "" Then
MsgBox ("Existe(m) campo(s) em branco, verifique")
Else 'se não, faz a busca no BD
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select * from receitas"
Set rs = .Execute
End With
With rs
.Filter = "cod = " & Text_cod.Text & " "
If .BOF And .EOF Then 'se não achar identifica
'como inclusão
vok = MsgBox("Alterações salvas com sucesso!", vbOKOnly, "Alterar receita")
limpar_campos
travar_campos
preenche_list
End With
End If
End With
End If
End Sub
'subprocedimento que carrega a lista com os registros
'do BD quando executado no evento Load do Form
Private Sub preenche_list()
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select * from receitas"
Set rs = .Execute
End With
Do While Not rs.EOF
If Not IsNull(rs!receita) Then
List_receitas.AddItem rs!receita
End If
rs.MoveNext
Loop
End Sub
'subprocedimento que quando chamado limpa os controles
'do form
Private Sub limpar_campos()
'subprocedimento que faz a exclusão de um registro
'no BD
Private Sub excluir()
'se o campo com o numero do codigo estiver em branco
'não executa nada
If Text_cod.Text = "" Then
MsgBox ("Não existe receita para exclusão, verifique.")
Else 'se não estiver em branco solicita a confirmação
'de exclusão do registro
vinfo = MsgBox("Deseja excluir esta receita ?", vbYesNo + vbQuestion, "Excluir receita")
If vinfo = vbYes Then 'se confirmado então exclui
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = " delete from receitas where cod = " & Text_cod.Text & ";"
.Execute
End With
End If
limpar_campos 'limpa os campos
preenche_list 'preenche a lista novamente
End If
End Sub
Pergunta
frata
Prezados colegas.
Estou tentando adaptar um código, de cadastro de receitas para cadastro de clientes, e decorre que no código anterior não aceita campos nulos para serem inseridos no BD, mas no programa atual de clientes, é necessário que apenas os dois primeiros campos não possam ser nulos, que seriam "nome" e "endereço". Será que alguém sabe como resolver isso. Antecipadamente agradeço. Frata
Estou postando o código abaixo.
'declarando os objetos necessários
'command e recordset para interagir com o BD
'e declarando variavel para utilizar msgbox
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim vinfo As Integer
'chamando a sub que carrega a lista com os dados do BD
Private Sub Form_Load()
preenche_list
End Sub
'descarregando os objetos command e recordset quando
'fechar o form e limpando os arquivos temp criados
Private Sub Form_Unload(Cancel As Integer)
Set cmd = Nothing
Set rs = Nothing
Set cnnreceitas = Nothing
If Dir("c:*.tmp") <> "" Then
On Error Resume Next
Kill "c:*.tmp"
End If
End Sub
'quando der duplo click na lista
'filtra as informações no BD e joga nos campos
'para alterar
Private Sub List_receitas_DblClick()
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select * from receitas"
Set rs = .Execute
End With
With rs
.Filter = " receita like '" & List_receitas.Text & "'"
Frame_cadastro.Visible = True
Frame_Localizar.Visible = False
Toolbar1.Visible = False
Toolbar2.Visible = True
travar_campos
Text_cod = !cod
Text_receita = !receita
Text_ingredientes = !ingredientes
Text_preparo = !preparo
Text_email = !email
End With
End Sub
'codigo que faz a busca na List quando é digitado
'na text
Private Sub Text1_Change()
On Error GoTo trataerro
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select * from receitas"
Set rs = .Execute
End With
With rs
.Filter = " receita like '%" & Text1.Text & "%'"
If .BOF And .EOF Then
MsgBox ("Sequencia de caracteres não encontrado na lista")
Else
List_receitas = rs!receita
End If
End With
trataerro:
With Err
If .Number <> 0 Then
.Number = 0
End If
End With
End Sub
'faz as alterações entre as toolbar e os frames
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
Toolbar1.Visible = False
Toolbar2.Visible = True
Frame_cadastro.Visible = True
Frame_Localizar.Visible = False
Case 2
Frame_Localizar.Visible = True
Text1.Text = ""
End Select
End Sub
'chama os procedimentos de gravar, inserir ou retornar
'para o outro frame
Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
Case 1
NOVO
Case 2
Gravar
Case 3
If Text_cod.Text <> "" Then
liberar_campos
Else
MsgBox ("Escolha uma receita na lista através do menu Localizar, dê duplo click na receita a ser alterada")
End If
Case 4
excluir
Case 5
Toolbar2.Visible = False
Toolbar1.Visible = True
Frame_cadastro.Visible = False
limpar_campos
preenche_list
End Select
End Sub
'subprocedimento que prepara a inserção de um novo
'registro no BD
Private Sub NOVO()
vinfo = MsgBox("Deseja inserir nova receita no Livro de Receitas ?", vbYesNo + vbQuestion, "Nova receita")
If vinfo = vbYes Then
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select max(cod) as Mcod from receitas"
Set rs = .Execute
End With
With rs
If IsNull(rs!Mcod) Then
Text_cod.Text = 1
Else
limpar_campos
preenche_list
Text_cod.Text = !Mcod + 1
End If
End With
Text_receita.Locked = False
Text_ingredientes.Locked = False
Text_preparo.Locked = False
Text_email.Locked = False
Text_receita.SetFocus
End If
End Sub
'subprocedimento para gravar um registro novo
'ou alterar um registro existente
Private Sub Gravar()
'se houver campos em branco informa ao usuario
If Text_receita.Text = "" Or _
Text_ingredientes.Text = "" Or _
Text_preparo.Text = "" Then
MsgBox ("Existe(m) campo(s) em branco, verifique")
Else 'se não, faz a busca no BD
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select * from receitas"
Set rs = .Execute
End With
With rs
.Filter = "cod = " & Text_cod.Text & " "
If .BOF And .EOF Then 'se não achar identifica
'como inclusão
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "insert into receitas" & _
"(cod,email, receita, ingredientes, preparo)values('" & _
Text_cod.Text & "','" & _
Text_email & "','" & _
Text_receita & "','" & _
Text_ingredientes.Text & "','" & _
Text_preparo.Text & "');"
.Execute 'grava
vinfo = MsgBox("Receita salva com sucesso!", vbOKOnly, "Salvar receita")
limpar_campos
travar_campos
preenche_list
End With
Else 'se achar o registro identifica como alteração
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = " update receitas set " & _
"receita = '" & Text_receita.Text & "'," & _
"email = '" & Text_email.Text & "'," & _
"ingredientes = '" & Text_ingredientes.Text & "'," & _
"preparo = '" & Text_preparo.Text & "'" & _
"where cod = " & Text_cod.Text & ";"
.Execute
vok = MsgBox("Alterações salvas com sucesso!", vbOKOnly, "Alterar receita")
limpar_campos
travar_campos
preenche_list
End With
End If
End With
End If
End Sub
'subprocedimento que carrega a lista com os registros
'do BD quando executado no evento Load do Form
Private Sub preenche_list()
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = "select * from receitas"
Set rs = .Execute
End With
Do While Not rs.EOF
If Not IsNull(rs!receita) Then
List_receitas.AddItem rs!receita
End If
rs.MoveNext
Loop
End Sub
'subprocedimento que quando chamado limpa os controles
'do form
Private Sub limpar_campos()
Text_receita.Text = ""
Text_email.Text = ""
Text_ingredientes.Text = ""
Text_preparo.Text = ""
Text_cod.Text = ""
List_receitas.Clear
End Sub
'subprocedimento que trava os textbox
Private Sub travar_campos()
Text_receita.Locked = True
Text_ingredientes.Locked = True
Text_preparo.Locked = True
Text_email.Locked = True
End Sub
'subprocedimento que destrava os textbox
Private Sub liberar_campos()
Text_receita.Locked = False
Text_ingredientes.Locked = False
Text_preparo.Locked = False
Text_email.Locked = False
End Sub
'subprocedimento que faz a exclusão de um registro
'no BD
Private Sub excluir()
'se o campo com o numero do codigo estiver em branco
'não executa nada
If Text_cod.Text = "" Then
MsgBox ("Não existe receita para exclusão, verifique.")
Else 'se não estiver em branco solicita a confirmação
'de exclusão do registro
vinfo = MsgBox("Deseja excluir esta receita ?", vbYesNo + vbQuestion, "Excluir receita")
If vinfo = vbYes Then 'se confirmado então exclui
With cmd
.ActiveConnection = cnnreceitas
.CommandType = adCmdText
.CommandText = " delete from receitas where cod = " & Text_cod.Text & ";"
.Execute
End With
End If
limpar_campos 'limpa os campos
preenche_list 'preenche a lista novamente
End If
End Sub
Link para o comentário
Compartilhar em outros sites
1 resposta a esta questão
Posts Recomendados
Participe da discussão
Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.