VBA - Cadastro de
instrumentos Musicais
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:
Na tela de cadastro, na parte inferior direita, é exibido o status da operação, ou seja, qual operação você está fazendo no momento:
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