All posts by kedim43

VBA – Modelo De Cadastro de Cheque

Salve Galera.

Como prometido, aqui esta um dos meus modelos completos para que todos possam conhecer um pouco mais do meu trabalho em VBA.

Cadastro simples para cheques. Vamos Botar As  Mãos No Código.

Dessa vez vou deixar sem descrever os textboxs e os label, então, espero que todos adaptem o código às suas necessidades. São ao todo:

  • 11 TextBoxs
  • 01 ComboBox
  • 07 Botões de comando

O restante é com vocês, detalhe: vou comentar para que todos possam entender cada parte do código.

Código:

' Ai vai o código, não se assustem galera, faz parte mesmo.Dim registros As Integer
' Aqui a variavel global
 
Dim registros As Integer
 
' Aqui esta o comando responsavel por buscar as informações
 
Private Sub Command_buscar_Click()
    'Verificar se foi digitado um nome na primeira caixa de texto
 
    If Text_codigo.Text = "" Then
        MsgBox ("Digite Um Codigo Válido"), vbInformation, ("Sistema Live - Free")
 
        Text_codigo.SetFocus
        GoTo Linha1
    End If
 
    With Worksheets("Cartao").Range("A:A")
        Set c = .Find(Text_codigo.Value, LookIn:=xlValues, LookAt:=xlPart)
        If Not c Is Nothing Then
 
            'Repare na localização e os nomes dos textboxs abaixo
 
            Text_codigo.Value = c.Value
 
            Text_nome.Value = c.Offset(0, 1).Value
            Text_cpf.Value = c.Offset(0, 2).Value
            Text_rg.Value = c.Offset(0, 3).Value
 
            Text_agencia.Value = c.Offset(0, 4).Value
            Combo_banco.Value = c.Offset(0, 5).Value
            Text_conta.Value = c.Offset(0, 6).Value
            Text_digito.Value = c.Offset(0, 7).Value
 
            Text_de.Value = c.Offset(0, 8).Value
            Text_ate.Value = c.Offset(0, 9).Value
            Text_tempocc.Value = c.Offset(0, 10).Value
            Text_situacao.Value = c.Offset(0, 11).Value
 
        Else
            MsgBox ("Este Cadastro Não Foi Localizado!!"), vbInformation, ("Sistema Live - Free")
 
            Text_codigo.SetFocus
        End If
    End With
Linha1:
End Sub
 
' Aqui o comando Cadastrar
 
Private Sub Command_cadastrar_Click()
 
    'Resposta sim e não - tomada de decisão, lembram?
 
    Dim Reposta As String
    Reposta = MsgBox("Deseja Cadastrar Os Dados Agora?", vbYesNo, "Sistema Live - Free")
    If Reposta = vbYes Then
 
        ' Nome da pasta onde sera gravado os dados
 
        Registro = Worksheets("Cartao").UsedRange.Rows.Count + 1
 
        ' Primeira Parte do codigo, neste exemplo usei a plan14, no seu caso basta mudar para o numero da sua
        ' plan que vc renomeiou para (Cartao) seu o (~)
        'Repare que os textboxs mudam de posição a cada linha e ação desejada
 
        Plan14.Cells(Registro, 1) = Me.Text_codigo
        Plan14.Cells(Registro, 2) = Me.Text_nome
        Plan14.Cells(Registro, 3) = Me.Text_cpf
        Plan14.Cells(Registro, 4) = Me.Text_rg
 
        Plan14.Cells(Registro, 5) = Me.Text_agencia
        Plan14.Cells(Registro, 6) = Me.Combo_banco
        Plan14.Cells(Registro, 7) = Me.Text_conta
        Plan14.Cells(Registro, 8) = Me.Text_digito
 
        Plan14.Cells(Registro, 9) = Me.Text_de
        Plan14.Cells(Registro, 10) = Me.Text_ate
        Plan14.Cells(Registro, 11) = Me.Text_tempocc
        Plan14.Cells(Registro, 12) = Me.Text_situacao
 
        ' Aqui um segredo, o auto ajuste das colunas na gravação de dados
 
        Plan14.Range(Columns(2), Columns(12)).AutoFit
 
        MsgBox ("Cadastro Efetuado Com Sucesso!"), vbInformation, ("Sistema Live - Free")
 
        'Limpando os textos digitados
 
        Me.Text_codigo.Text = ""
        Me.Text_nome.Text = ""
        Me.Text_cpf.Text = ""
        Me.Text_rg.Text = ""
 
        Me.Text_agencia.Text = ""
        Me.Combo_banco.Text = ""
        Me.Text_conta.Text = ""
        Me.Text_digito.Text = ""
 
        Me.Text_de.Text = ""
        Me.Text_ate.Text = ""
        Me.Text_tempocc.Text = ""
        Me.Text_situacao.Text = ""
 
        Me.Text_nome.SetFocus
 
    End If
 
    ' Resposta não - tomada de decisão
 
    If Reposta = vbNo Then
 
        Me.Text_codigo.Text = ""
        Me.Text_nome.Text = ""
        Me.Text_cpf.Text = ""
        Me.Text_rg.Text = ""
 
        Me.Text_agencia.Text = ""
        Me.Combo_banco.Text = ""
        Me.Text_conta.Text = ""
        Me.Text_digito.Text = ""
 
        Me.Text_de.Text = ""
        Me.Text_ate.Text = ""
        Me.Text_tempocc.Text = ""
        Me.Text_situacao.Text = ""
 
        Me.Text_nome.SetFocus
 
        MsgBox ("Seus Dados Não Foram Gravados"), vbInformation, ("Sistema Live - Free")
    End If
 
    Me.Command_cadastrar.Enabled = False
 
End Sub
 
' Aqui esta o comando editar, tão procurado e desejado no mundo VBA
 
Private Sub Command_editar_Click()
 
    ' Tomada de decisão
 
    Dim Reposta As String
    Reposta = MsgBox("Deseja Realmente Editar Agora?", vbYesNo, "Sistema Live - Free")
 
    If Reposta = vbYes Then
 
        Registro = Me.Text_codigo.Text
 
        ' Segunda Parte
 
        Plan14.Cells(Registro, 1) = Me.Text_codigo
        Plan14.Cells(Registro, 2) = Me.Text_nome
        Plan14.Cells(Registro, 3) = Me.Text_cpf
        Plan14.Cells(Registro, 4) = Me.Text_rg
 
        Plan14.Cells(Registro, 5) = Me.Text_agencia
        Plan14.Cells(Registro, 6) = Me.Combo_banco
        Plan14.Cells(Registro, 7) = Me.Text_conta
        Plan14.Cells(Registro, 8) = Me.Text_digito
 
        Plan14.Cells(Registro, 9) = Me.Text_de
        Plan14.Cells(Registro, 10) = Me.Text_ate
        Plan14.Cells(Registro, 11) = Me.Text_tempocc
        Plan14.Cells(Registro, 12) = Me.Text_situacao
 
        MsgBox ("Dados Editados Com Sucesso!"), vbInformation, ("Sistema Live - Free")
 
        Me.Text_codigo.Text = ""
        Me.Text_nome.Text = ""
        Me.Text_cpf.Text = ""
        Me.Text_rg.Text = ""
 
        Me.Text_agencia.Text = ""
        Me.Combo_banco.Text = ""
        Me.Text_conta.Text = ""
        Me.Text_digito.Text = ""
 
        Me.Text_de.Text = ""
        Me.Text_ate.Text = ""
        Me.Text_tempocc.Text = ""
        Me.Text_situacao.Text = ""
 
        Me.Text_nome.SetFocus
 
    End If
 
    ' Resposta não- tomada de decisão
    If Reposta = vbNo Then
 
        Me.Text_codigo.Text = ""
        Me.Text_nome.Text = ""
        Me.Text_cpf.Text = ""
        Me.Text_rg.Text = ""
 
        Me.Text_agencia.Text = ""
        Me.Combo_banco.Text = ""
        Me.Text_conta.Text = ""
        Me.Text_digito.Text = ""
 
        Me.Text_de.Text = ""
        Me.Text_ate.Text = ""
        Me.Text_tempocc.Text = ""
        Me.Text_situacao.Text = ""
 
        Me.Text_nome.SetFocus
 
        MsgBox ("Seus Dados Não Foram Editados E Não Foram Cadastrados!"), vbInformation, ("Sistema Live - Free")
    End If
 
End Sub
 
' Aqui está o comando excluir - Aeeeeeeeeeeee Laiaaaaaaaaaaa............
 
Private Sub Command_excluir_Click()
 
    ' Tomada de decisão
 
    Dim Reposta As String
 
    Reposta = MsgBox("Deseja Realmente Excluir O Registro Informado?", vbYesNo, "Sistema Live - Free")
 
    If Reposta = vbYes Then
 
    ' Lembre - se de mudar a plan aqui tambem
 
    Plan14.Range("A" & Me.Text_codigo).EntireRow.Delete
 
    MsgBox ("Dados Excluidos Com Sucesso Do Sistema!"), vbInformation, ("Sistema Live - Free")
    End If
 
    If Reposta = vbNo Then
 
    MsgBox ("Seus Dados Não Foram Excluidos!"), vbInformation, ("Sistema Live - Free")
 
    Me.Text_codigo.Text = ""
    Me.Text_nome.Text = ""
    Me.Text_cpf.Text = ""
    Me.Text_rg.Text = ""
 
    Me.Text_agencia.Text = ""
    Me.Combo_banco.Text = ""
    Me.Text_conta.Text = ""
    Me.Text_digito.Text = ""
 
    Me.Text_de.Text = ""
    Me.Text_ate.Text = ""
    Me.Text_tempocc.Text = ""
    Me.Text_situacao.Text = ""
 
    Me.Text_nome.SetFocus
 
    End If
 
End Sub
 
' Comando Limpar os dados
 
Private Sub Command_limpar_Click()
 
    Me.Text_codigo.Text = ""
    Me.Text_nome.Text = ""
    Me.Text_cpf.Text = ""
    Me.Text_rg.Text = ""
 
    Me.Text_agencia.Text = ""
    Me.Combo_banco.Text = ""
    Me.Text_conta.Text = ""
    Me.Text_digito.Text = ""
 
    Me.Text_de.Text = ""
    Me.Text_ate.Text = ""
    Me.Text_tempocc.Text = ""
    Me.Text_situacao.Text = ""
 
    Me.Text_nome.SetFocus
 
End Sub
 
' Habilitar o botão novo cadastro - Ufa já tamo acabando galera, paciência ai e muita calma nessa hora.
 
Private Sub Command_novo_Click()
    Me.Command_cadastrar.Enabled = True
 
    Me.Text_codigo.Text = ""
    Me.Text_nome.Text = ""
    Me.Text_cpf.Text = ""
    Me.Text_rg.Text = ""
 
    Me.Text_agencia.Text = ""
    Me.Combo_banco.Text = ""
    Me.Text_conta.Text = ""
    Me.Text_digito.Text = ""
 
    Me.Text_de.Text = ""
    Me.Text_ate.Text = ""
    Me.Text_tempocc.Text = ""
    Me.Text_situacao.Text = ""
 
    ' Sua pasta que recebera os dados
 
    Registro = Worksheets("Cartao").UsedRange.Rows.Count + 1
 
    Me.Text_codigo = Registro
 
    Me.Text_nome.SetFocus
End Sub
 
Private Sub Command_sair_Click()
    Unload Me
End Sub
 
' Aqui o campo CPF - olha que coisa fera!
 
Private Sub Text_cpf_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'Limita a Qde de caracteres
    Text_cpf.MaxLength = 14
 
    Select Case KeyAscii
    Case 8, 48 To 57 ' BackSpace e numericos
    If Len(Text_cpf) = 3 Or Len(Text_cpf) = 12 Then
        Text_cpf.Text = Text_cpf.Text & "."
        SendKeys "{End}", False
 
    ElseIf Len(Text_cpf) = 7 Then
        Text_cpf.Text = Text_cpf.Text & "."
 
    ElseIf Len(Text_cpf) = 11 Then
        Text_cpf.Text = Text_cpf.Text & "-"
        SendKeys "{End}", False
    End If
 
    Case Else ' o resto é travado
        KeyAscii = 0
    End Select
End Sub
 
' Letra sempra maiuscula no nome - UHUUUUUUUUUUUUUU!
 
Private Sub Text_nome_Change()
    Text_nome.Value = UCase(Text_nome.Value)
End Sub
 
Private Sub Text_situacao_Change()
    Text_situacao.Value = UCase(Text_situacao.Value)
End Sub
 
' Than Than, por fim o combo que carrega os bancos, Fera demais galera...
 
Private Sub UserForm_Initialize()
 
    ' Bancos
    Combo_banco.AddItem "Banco Do Brasil"
    Combo_banco.AddItem "Caixa Economica Federal"
    Combo_banco.AddItem "Bradesco"
    Combo_banco.AddItem "Itau"
    Combo_banco.AddItem "Bamerindus"
    Combo_banco.AddItem "Santander"
    Combo_banco.AddItem "Banco Real"
    Combo_banco.AddItem "Citibank Brasil"
    Combo_banco.AddItem "Banco Mercantil Do Brasil"
    Combo_banco.AddItem "Outro..."
 
    ' Aqui onde se inicia ao iniciar o form
 
    Me.Text_nome.SetFocus
End Sub

Ufa! Quanta novidade! Espero que todos gostem e estou sempre a disposição pra ajudar a todos.

Agradeço também pela paciência de vocês em lerem meus posts e rirem um pouco das brincadeiras. Até nosso proximo post.

Abração a todos

Excel – Sua Mensagem Pessoal

Fala Galera.

Hoje troxe para todos que tem acessado os meus tutoriais, uma dica bem interresante. Sua mensagem pessoal ao finalizar a sua apliacação no Excel Vba.

O código é bem simples. Ao acessar o modo VBA do Excel (Alt+F11), localize a instrução:

Esta_Pasta_De_Trabalho.

Clique 02 vezes nela e colei o código abaixo. Vamos colocar As Mãos No Código. Basta copiar e colar.

'Aqui Finalizamos A Pasta de Trabalho e Atualizamos Todos Os Dados
Private Sub workbook_BeforeClose(cancel As Boolean)
    Dim ws As Workbook
    Dim resp As VbMsgBoxResult
    Set ws = ThisWorkbook
    If ws.Saved = False Then
        ws.Saved = True
 
        'Aqui vai a sua mensagem
        resp = MsgBox("Gostaria de Salvar As Alterações" & _
                      "Nesta Pasta de Trabalho?", vbYesNoCancel Or vbQuestion, "Sistema Live Free - Salvar Personalizada")
 
        ' Resposta Sim
 
        If resp = vbYes Then
            ws.Save
 
            'Outra mensagem pessoal
 
            MsgBox ("Seus Dados Foram Atualizados Com Sucesso!"), vbInformation, ("Até Mais - Sistema Live Free")
 
            'Resposta cancelar
        ElseIf resp = vbCancel Then
            cancel = True
        End If
    Else
        MsgBox ("Obrigado E Até Mais"), vbInformation, ("Sistema Live Free")
    End If
End Sub

Fim do código. Bom é isso aí!

Agora finalize sua aplicação e tome uma decisão. Fácil demais.

Para o proximo post, vou lhes mostrar algo super legal. Um aplicatico completo com todos os comandos:  Novo; Cadastrar; Localizar; Editar; Excluir e Fechar.

Valeu galera. Até nosso proximo post.