Todos os posts de kedim43

VBA – Modelo De Cadastro de Cheque

27 27UTC January 27UTC 2013 kedim43

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

' 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, VBA

Excel – Sua Mensagem Pessoal

10 10UTC December 10UTC 2012 kedim43

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.

Excel, Microsoft Office, VBA

VBA – Cadastrar Usuário e Senha no Excel

13 13UTC November 13UTC 2012 kedim43

Beleza galera. Vamos terminar nosso aplicativo de login? Vamos colocar as Mãos No Código!

No tutorial anterior, mostrei a vocês, como criar um modo de login e senha. Hoje vamos ver como se cadastra um novo usuário. Para isso, insira um form que vai ser chamado de Menu; dentro deste form, insira um CommandButton e dentro dele este código:

Código do CommandButton1

Cadastrar.show

Agora você necessita criar outro form com os seguintes campos:

02 Labels
02 Textboxs

Para os labels, entre com os nomes:

UserName
Password

Para os Textbox:

txtNome
txtSenha

03 CommandButton

ComamandButton1 -Salvar
CommandButton2 -Fechar
CommandButton3 -Limpar

Agora galera, vamos ao código da nossa aplicação.

Código Completo

'Aqui está o botão fechar
 
Private Sub Fechar_Click()
    Unload Me
End Sub
 
'Aqui está o botão Limpar
Private Sub Limpar_Click()
    txtNome = ""
    txtSenha = ""
 
    txtNome.SetFocus
End Sub
 
'Aqui está o botão responsável por salvar os dados na Planilha de Login lembram da mesma no topico anterior?
Private Sub Salvar_Click()
 
'Tomada de Decisão Sim e Não
    Dim Reposta As String
    Reposta = MsgBox("Deseja Salvar Este Usuário Agora?", vbYesNo, "Novo usuário")
    If Reposta = vbYes Then
 
        'Nossa pasta renomeada no post anterior e onde gravaremos os novos usuários e senhas
 
        totalregistro = Worksheets("Login").UsedRange.Rows.Count + 1
 
        'Campo Obrigatório
        If txtNome.Text = "" Then
            MsgBox "Necessito De Um Nome Para Continuar. "
            txtNome.SetFocus
            Exit Sub
        End If
 
        With Worksheets("Login")
            .Cells(totalregistro, 1) = txtNome
            .Cells(totalregistro, 2) = txtSenha
 
        End With
 
        'Mensagem apos a gravação de dados
 
        MsgBox ("Gravado Com Sucesso"), vbInformation, ("Novo usuário")
        txtNome = ""
        txtSenha = ""
 
        txtNome.SetFocus
    End If
    'Resposta Não aqui
    If Reposta = vbNo Then
 
        'Mensagem caso sua resposta seja não
        MsgBox ("Seus Dados Não Foram Gravados"), vbInformation, ("Novo usuário")
 
        txtNome = ""
        txtSenha = ""
 
        txtNome.SetFocus
    End If
End Sub

Beleza! Agora é o seguinte.Vamos fazer nossa aplicação aparecer depois que digitamos o usuário e senha e clicamos em Login, a ação tomada será chamar o form de menu. Lembram?

basta que você que copiou o exemplo anterior localize esta linha:

*****"Seu Aplicativo será carregado, substituindo esta linha para a que você necessite que seja carregado em primeiro plano (form1,Menu,Dados...Etc)
Delete a mesma e no lugar da mesma, entre com este código.
***Menu.Show vbmodal

Agora você já tem em mãos, a Tela de Login, A Tela de Menu e a Tela de Cadastro de Usuário.

Fiquem a vontade para adaptarem as suas necessidades.

Abração e sempre que necessitarem estou sempre aqui com muitas coisas bem legais para mostrar a quem está querendo aprender o VBA.

Excel, Microsoft Office, VBA

VBA – Login com Banco de Dados em Excel

25 25UTC October 25UTC 2012 kedim43 8 Comentários

Beleza Galera.

Estive vendo que a maioria sempre necessita, ao desenvolver uma aplicação de um sistema de Login onde se
possa cadastrar novos usuários e até mesmo senhas.

Então resolvi deixar pra galera, um pequeno sistema de Login em VBA Excel.

Vamos colocar as Mãos No Código.

Necessita que você acesse o Excel, seja 2007 ou 2003, …
Renomei a Plan1 para Login…
Na Coluna A entre com o Nome de Usuário = ADMIN (este nome Maiusculo, o TextBox já está formatado para faze-lo pra vocês, basta que seja cadastarado em maiusculo dentro da Coluna A da Plan1 que você já renomeou para Login)
na Coluna B entre com a Senha = admin. (Desta forma descrita aqui) caso contrario você não irá acessar a sua planilha de dados.
Pressione ALT + F11;
Insira um Form Novo;

Para este aplicativo você necessitará de 02 textboxs, 02 labels, 02 CommandButton. Nomes para cada item citados acima (acho que ando muito bom pra vocês)

Para os labels
UserName
Password

Nome para os textboxs
TBx_Usuario
TBx_Senha

Para O Botão de Comando OK
CBt_Ok

e para o segundo Botão de Comando (CommandButton2). insira este código dentro dele;

ThisWorkbook.Close SaveChanges:=True

Onde este comando, salvará e finalizará o seu aplicativo caso alquem tente acessar a mesma sem senha ao clicar em fechar tentando assim, invadir o seu aplicativo.

Galera, agora é o seguinte. Copie o codigo abaixo depois de remonear cada textbox e cada Botão de acordo com sua necessidade, basta clicar duas vezes no form, delete a instrução que aperecer e insira este pequeno código aqui:

    Private Sub CommandButton2_Click()
    ThisWorkbook.Close SaveChanges:=True
    End Sub
 
 
    Private Sub UserForm_Activate()
    'Neste caso você tem a opção de mostrar ou ocultar o excel, basta mudar a instrução TRUE abaixo para False
                Application.Visible = True
 
                TBx_Senha.Enabled = TBx_Usuario.Text <> ""
 
                CBt_Ok.Enabled = (TBx_Usuario.Text <> "" And TBx_Senha.Text <> "")
    End Sub
 
    Private Sub CBt_Ok_Click()
 
                Dim Linha As Integer
 
                On Error GoTo NaoEncontrado
 
                Linha = Sheets("Login").Range("A:A").Find(TBx_Usuario).Row
 
                If TBx_Senha = Sheets("Login").Cells(Linha, 2) Then
 
                   MsgBox ("Seja Bem Vindo (a) ") & TBx_Usuario, vbInformation, ("Login - Live Free")
 
                   Unload Me
 
                   'Tela de acesso ao sistema aqui
                  'Seu Aplicativo será carregado, substituindo esta linha para a que você necessite que seja carregado em primeiro plano (form1,Menu,Dados...Etc)
 
 
                Else
 
                   MsgBox ("A senha não confere"), vbInformation, ("Login - Live Free")
 
                   TBx_Senha = ""
 
                   TBx_Senha.SetFocus
 
                End If
 
                Exit Sub
 
    NaoEncontrado:
 
                MsgBox ("Usuário não cadastrado."), vbInformation, ("Login - Live Free")
 
                TBx_Usuario = ""
 
                TBx_Usuario.SetFocus
 
    End Sub
 
 
 
    Private Sub TBx_Usuario_Change()
 
                TBx_Senha.Enabled = TBx_Usuario.Text <> ""
 
                CBt_Ok.Enabled = (TBx_Usuario.Text <> "" And TBx_Senha.Text <> "")
 
    'Aqui o código que modifica a letra digitada para a forma maiuscula
 
    TBx_Usuario.Value = UCase(TBx_Usuario.Value)
    End Sub
 
 
 
    Private Sub TBx_Senha_Change()
 
                CBt_Ok.Enabled = (TBx_Usuario.Text <> "" And TBx_Senha.Text <> "")
 
    End Sub
 
    Private Sub UserForm_Initialize()
    ' Metodo Invisivel do Excel
    Application.Visible = False
 
    TBx_Usuario.SetFocus
    End Sub
 
 
    'Aqui vai algo bem legal de bonus pra todos, iremos desabilitar tambem o Botão de Fechar no alto do Form, travando o mesmo para não ser finalizado.
 
    Private Sub UserForm_QueryClose _
      (Cancel As Integer, CloseMode As Integer)
        If CloseMode = vbFormControlMenu Then
 
    'Tente finalizar e veja esta mensagem na tela
 
            MsgBox "Esta Ação Não É Permitida.Desculpe!", vbInformation, "AVISO - Live Free"
            Cancel = True
        End If
    End Sub
 
    Já quase me esquecendo
    Para que o sistema de login inicie em primeiro lugar, basta ir na opção do lado esquerdo, procure esta instrução:
    -Esta_Pasta_De_Trabalho
    De 02 cliques nela e dentro, cole este codigo:
 
 
    Private Sub Workbook_Open()
    Login.Show
    End Sub

Private Sub CommandButton2_Click() ThisWorkbook.Close SaveChanges:=True End Sub Private Sub UserForm_Activate() 'Neste caso você tem a opção de mostrar ou ocultar o excel, basta mudar a instrução TRUE abaixo para False Application.Visible = True TBx_Senha.Enabled = TBx_Usuario.Text <> "" CBt_Ok.Enabled = (TBx_Usuario.Text <> "" And TBx_Senha.Text <> "") End Sub Private Sub CBt_Ok_Click() Dim Linha As Integer On Error GoTo NaoEncontrado Linha = Sheets("Login").Range("A:A").Find(TBx_Usuario).Row If TBx_Senha = Sheets("Login").Cells(Linha, 2) Then MsgBox ("Seja Bem Vindo (a) ") & TBx_Usuario, vbInformation, ("Login - Live Free") Unload Me 'Tela de acesso ao sistema aqui 'Seu Aplicativo será carregado, substituindo esta linha para a que você necessite que seja carregado em primeiro plano (form1,Menu,Dados...Etc) Else MsgBox ("A senha não confere"), vbInformation, ("Login - Live Free") TBx_Senha = "" TBx_Senha.SetFocus End If Exit Sub NaoEncontrado: MsgBox ("Usuário não cadastrado."), vbInformation, ("Login - Live Free") TBx_Usuario = "" TBx_Usuario.SetFocus End Sub Private Sub TBx_Usuario_Change() TBx_Senha.Enabled = TBx_Usuario.Text <> "" CBt_Ok.Enabled = (TBx_Usuario.Text <> "" And TBx_Senha.Text <> "") 'Aqui o código que modifica a letra digitada para a forma maiuscula TBx_Usuario.Value = UCase(TBx_Usuario.Value) End Sub Private Sub TBx_Senha_Change() CBt_Ok.Enabled = (TBx_Usuario.Text <> "" And TBx_Senha.Text <> "") End Sub Private Sub UserForm_Initialize() ' Metodo Invisivel do Excel Application.Visible = False TBx_Usuario.SetFocus End Sub 'Aqui vai algo bem legal de bonus pra todos, iremos desabilitar tambem o Botão de Fechar no alto do Form, travando o mesmo para não ser finalizado. Private Sub UserForm_QueryClose _ (Cancel As Integer, CloseMode As Integer) If CloseMode = vbFormControlMenu Then 'Tente finalizar e veja esta mensagem na tela MsgBox "Esta Ação Não É Permitida.Desculpe!", vbInformation, "AVISO - Live Free" Cancel = True End If End Sub Já quase me esquecendo Para que o sistema de login inicie em primeiro lugar, basta ir na opção do lado esquerdo, procure esta instrução: -Esta_Pasta_De_Trabalho De 02 cliques nela e dentro, cole este codigo: Private Sub Workbook_Open() Login.Show End Sub

Fim do código.

Espero ter ajudado e que todos se sintam a vontade para modificarem o mesmo, conforme suas necessidades.

Para inserir outros usuáros e suas senhas, lhes mostrarem isso em outra oportunidade.

Valeu galera. Até nosso proximo post.

Tomás Vásquez – Blog

Todos os posts de kedim43

VBA – Modelo De Cadastro de Cheque

Excel – Sua Mensagem Pessoal

Tecnologia e Programação