Ir para conteúdo
Fórum Script Brasil
  • 0

Null


frata

Pergunta

Prezados colegas:

Segue abaixo um código que quando vai salvar no banco de dados um Access ele pede que todos os campos do formulário estejam preenchidos. Será que alguém sabe como modificar isso. Obrigado!

'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

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

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.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...