VBA - Cadastro de instrumentos Musicais


Atenção ! Recebi este projeto de um colaborador e resolvi publicar (após muita relutância) devido a inúmeras consultas sobre VBA com Excel.

Portanto que fique claro que : VBA não é a minha praia  e  que  eu só a utilizo quando estritamente necessário para intercambiar com aplicações Office .

Outra coisa, o projeto não é de minha autoria, e, portanto não dou suporte ao mesmo; estou publicando o código para ajudar quem deseja estudar VBA e não encontra um exemplo prático em português com Excel.

Este exemplo é um cadastro de instrumento musicais em Excel. Atente para o fato de que ele usa planilhas Excel como fonte de dados.

Você pode iniciar o projeto Abrindo o Excel e no menu Ferramentas selecionar : Macro -> Editor do Visual Basic

A seguir no menu Inserir inclua um formulário (UseForm) e inclua os objetos no formulário conforme a figura. A seguir selecione o evento para colocar o código que esta descrito no final do artigo.

Bom estudo e boa sorte !

Cadastro de Instrumentos Musicais em VBA com Excel

Nosso programa em VBA, consiste em um sistema para cadastro de produtos de uma loja de instrumentos musicais. Nele será possível fazer a inclusão de novos produtos, definido seu código, o nome, que tipo de instrumento é, a marca do fabricante, seu preço, a quantidade, e por fim escrever alguma observação sobre o produto.

Também é possível editar os excluir algum produto depois de cadastrado. Assim como imprimir, ou fazer uma busca entre muitos registros. Foi criada também uma área para backup, onde o usuário informa onde deve ser feita a cópia e o nome do arquivo. É um sistema simples que serve para auxiliar na administração de uma loja de instrumentos musicais.

A seguir mostraremos um passo a passo da utilização do programa:

Tela de login do sistema  

      

 Nessa tela o usuário irá entrar com seu nome e senha para ter acesso ao sistema, lembrando que o nome e senha já deverão estar cadastrados. Caso o usuário não esteja cadastrado será mostrada uma tela de erro com a seguinte mensagem:

 

 

  A senha também pode não conferir com a cadastrada, então será mostrada a seguinte tela:

 

 Se ocorrer algum desses casos, procure digitar um usuário e senha existente. Quando o login e senha estiverem corretos será apresentada uma tela de boas vindas com o nome do usuário:

 

 Após ser validado no sistema será exibida a tela de menu, onde será possível acessar a área de cadastro de produtos ou sair do sistema:

Ao clicar em cadastro de produtos, a tela de cadastro será mostrada, aqui é onde poderemos fazer a inclusão, alteração ou exclusão de produtos. Também poderemos fazer uma consulta a um produto existente ou somente imprimir.

As opções da tela de cadastro são muitas, vamos analisá-las uma a uma. Na parte superior da tela temos a barra de navegação, nela podemos navegar pelos registros, indo ao próximo ou anterior, e também pulando para o primeiro ou último registro.

Na área inferior da tela, temos os botões:

Caixa de texto: Usado para incluir novos registros

 

 

 Caixa de texto: Usado para alterar registros já existentes

 

 

Caixa de texto: Usado para imprimir o registro atual

 

 

Na tela de cadastro, na parte inferior direita, é exibido o status da operação, ou seja, qual operação você está fazendo no momento:

 

  Caixa de texto: E o último botão é o sair, usado para sair da tela de cadastro

 

 

Ao clicarmos no botão de consulta, será apresentada a janela de consulta, onde deveremos informar por qual campo iremos fazer a busca, e depois digitar o que estamos procurando:

 

 Na parte superior da tela temos duas “abas”, a de CADASTRO, que é onde estamos agora, e a de BACKUP, que é a que iremos clicar:

  Após clicarmos na aba BACKUP, será exibida a tela de backup, onde devermos informar o caminho e o nome do arquivo do backup, exemplo “c:\backup\backup2005.xls”. Após colocar o caminho é só clicar no botão backup que a cópia do seu arquivo será feita no caminho indicado:

   

 A seguir temos o código do projeto:

Frm_Login - Login

 

Private Sub UserForm_Activate()

            Application.Visible = False

            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 "Bem Vindo " & TBx_Usuario

               Unload Me

               Frm_Menu.Show

            Else

               MsgBox "A senha não confere"

               TBx_Senha = ""

               TBx_Senha.SetFocus

            End If

            Exit Sub

NaoEncontrado:

            MsgBox "Usuário não cadastrado."

            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 <> "")

End Sub

 

Private Sub TBx_Senha_Change()

            CBt_Ok.Enabled = (TBx_Usuario.Text <> "" And TBx_Senha.Text <> "")

End Sub

 

 

Frm_Menu - Menu de opções

 

Private Sub CBt_CadProduto_Click()

    Frm_Cadastro.Show

End Sub

 

 Private Sub CBt_Finalizar_Click()

  Unload Me

End Sub

 

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

           If MsgBox("Confirma a finalização do sistema?", vbYesNo + vbQuestion, "Confirmação") = vbYes Then

            ActiveWorkbook.Save

            Application.Quit

            Application.Visible = True

           Else

            Cancel = 1

           End If

End Sub

 

Frm_Cadastro - Cadastro do sistema

 

Option Explicit

 

'RA = REGISTRO ATUAL

'NR = NUMERO TOTAL DE REGISTROS

'OP = OPERAÇÃO

Dim RA As Integer, NR As Integer, OP As String

 

Private Sub CBt_backup_Click()

    ActiveWorkbook.SaveCopyAs (TBx_caminho.Text)

    TBx_caminho = ""

    TBx_caminho.SetFocus

End Sub

 

Private Sub UserForm_Activate()

            LControle

            Atribuir

            CBx_Tipo.AddItem "Corda"

            CBx_Tipo.AddItem "Sopro"

            CBx_Tipo.AddItem "Percussão"

End Sub

 

Private Sub LControle()

            RA = Range("RA")

            NR = Range("NR")

            OP = Range("OP")

End Sub

 

Private Sub GControle()

            Range("RA") = RA

            Range("OP") = OP

End Sub

 

Private Sub CBt_Primeiro_Click()

            RA = 1

            GControle

            Atribuir

End Sub

 

Private Sub CBt_Anterior_Click()

            RA = RA - 1

            GControle

            Atribuir

End Sub

 

Private Sub CBt_Proximo_Click()

            RA = RA + 1

            GControle

            Atribuir

End Sub

 

Private Sub CBt_Ultimo_Click()

            RA = NR

            GControle

            Atribuir

End Sub

 

Private Sub Atribuir()

            Dim Linha As Integer

            If NR = 0 Then

               Linha = RA + 2

            Else

               Linha = RA + 1

            End If

            TBx_Codigo = Sheets("Dados").Cells(Linha, 1)

            TBx_Instrumento = Sheets("Dados").Cells(Linha, 2)

            CBx_Tipo = Sheets("Dados").Cells(Linha, 3)

            TBx_Marca = Sheets("Dados").Cells(Linha, 4)

            TBx_Preco = Sheets("Dados").Cells(Linha, 5)

            TBx_Quantidade = Sheets("Dados").Cells(Linha, 6)

            TBx_Observacoes = Sheets("Dados").Cells(Linha, 7)

            Lbl_Operacao = OP & "..."

            Lbl_Apontador = RA & " / " & NR

            Operacao

            Navegacao

End Sub

 

Private Sub Navegacao()

            CBt_Primeiro.Enabled = (RA > 1 And OP = "Navegando")

            CBt_Anterior.Enabled = (RA > 1 And OP = "Navegando")

            CBt_Proximo.Enabled = (RA < NR And OP = "Navegando")

            CBt_Ultimo.Enabled = (RA <> NR And OP = "Navegando")

End Sub

 

Private Sub Operacao()

            CBt_Incluir.Enabled = (OP = "Navegando")

            CBt_Alterar.Enabled = (OP = "Navegando" And RA > 0)

            CBt_Excluir.Enabled = (OP = "Navegando" And RA > 0)

            CBt_Cancelar.Enabled = (OP = "Incluindo" Or OP = "Alterando")

            CBt_Consultar.Enabled = (OP = "Navegando" And NR > 1)

            CBt_Gravar.Enabled = (OP = "Incluindo" Or OP = "Alterando")

            CBt_Sair.Enabled = (OP = "Navegando")

            CBt_Imprimir.Enabled = (OP = "Navegando")

End Sub

 

Private Sub CBt_Incluir_Click()

            OP = "Incluindo"

            GControle

            RA = NR + 1

            Atribuir

            Fra_Dados.Enabled = True

            TBx_Codigo.SetFocus

End Sub

 

Private Sub CBt_Alterar_Click()

            OP = "Alterando"

            GControle

            Atribuir

            Fra_Dados.Enabled = True

            TBx_Codigo.SetFocus

End Sub

 

Private Sub CBt_Excluir_Click()

            If MsgBox("Confirma a exclusão?", vbYesNo + vbQuestion, "Confirmação") = vbYes Then

               Sheets("Dados").Rows(RA + 1).Delete

               If RA = NR Then

                  RA = RA - 1

                  GControle

               End If

               CBt_Cancelar_Click

            End If

End Sub

 

Private Sub CBt_Cancelar_Click()

            LControle

            OP = "Navegando"

            GControle

            Atribuir

            Fra_Dados.Enabled = False

End Sub

 

Private Sub CBt_Consultar_Click()

            Frm_Consulta.Show

            LControle

            Atribuir

End Sub

 

Private Sub CBt_Gravar_Click()

            If MsgBox("Confirma a operação?", vbYesNo + vbQuestion, "Confirmação") = vbYes Then

               Sheets("Dados").Cells(RA + 1, 1) = TBx_Codigo

               Sheets("Dados").Cells(RA + 1, 2) = TBx_Instrumento

               Sheets("Dados").Cells(RA + 1, 3) = CBx_Tipo

               Sheets("Dados").Cells(RA + 1, 4) = TBx_Marca

               Sheets("Dados").Cells(RA + 1, 5) = TBx_Preco

               Sheets("Dados").Cells(RA + 1, 6) = TBx_Quantidade

               Sheets("Dados").Cells(RA + 1, 7) = TBx_Observacoes

               GControle

               CBt_Cancelar_Click

            End If

End Sub

 

Private Sub CBt_Sair_Click()

  Unload Me

End Sub

 

Private Sub CBt_Imprimir_Click()

           Sheets("Dados").PrintOut

End Sub

 

Frm_Consulta - Consulta do sistema

 

Option Explicit

 

Private Sub CBt_Fechar_Click()

    Unload Me

End Sub

 

 

Private Sub UserForm_Activate()

            Dim N As Integer

            For N = 1 To 7

                CBx_Campo.AddItem Sheets("Dados").Cells(1, N)

            Next N

End Sub

 

Private Sub CBx_Campo_Change()

            TBx_Dado.SetFocus

End Sub

 

Private Sub CBt_Buscar_Click()

            If TBx_Dado.Text <> "" Then

               On Error GoTo NaoEncontrado

               Range("RA") = Sheets("Dados").Columns(CBx_Campo.ListIndex + 1).Find(TBx_Dado.Text).Row - 1

               Unload Me

               Exit Sub

NaoEncontrado:

               MsgBox "Dado " & TBx_Dado.Text & " Não encontrado.", vbOKOnly + vbCritical, "Resultado da Busca"

              

            End If

End Sub

 

E com isto encerramos o código que você deverá incluir no projeto usando o Editor de Códigos do Visual Basic do Excel.

 

Hasta la vista...


José Carlos Macoratti