VBA - Cadastro de instrumentos Musicais

Ateno ! Recebi este projeto de um colaborador e resolvi publicar (aps muita relutncia) devido a inmeras consultas sobre VBA com Excel. Portanto que fique claro que : VBA no a minha praia e que eu s a utilizo quando estritamente necessrio para intercambiar com aplicaes Office . Outra coisa, o projeto no de minha autoria, e, portanto no dou suporte ao mesmo; estou publicando o cdigo para ajudar quem deseja estudar VBA e no encontra um exemplo prtico em portugus 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 formulrio (UseForm) e inclua os objetos no formulrio conforme a figura. A seguir selecione o evento para colocar o cdigo 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 possvel fazer a incluso de novos produtos, definido seu cdigo, o nome, que tipo de instrumento , a marca do fabricante, seu preo, a quantidade, e por fim escrever alguma observao sobre o produto. Tambm possvel editar os excluir algum produto depois de cadastrado. Assim como imprimir, ou fazer uma busca entre muitos registros. Foi criada tambm uma rea para backup, onde o usurio informa onde deve ser feita a

cpia e o nome do arquivo. um sistema simples que serve para auxiliar na administrao de uma loja de instrumentos musicais. A seguir mostraremos um passo a passo da utilizao do programa: Tela de login do sistema

Nessa tela o usurio ir entrar com seu nome e senha para ter acesso ao sistema, lembrando que o nome e senha j devero estar cadastrados. Caso o usurio no esteja cadastrado ser mostrada uma tela de erro com a seguinte mensagem:

A senha tambm pode no conferir com a cadastrada, ento ser mostrada a seguinte tela:

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

Aps ser validado no sistema ser exibida a tela de menu, onde ser possvel 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 incluso, alterao ou excluso de produtos. Tambm poderemos fazer uma consulta a um produto existente ou somente imprimir.

As opes da tela de cadastro so muitas, vamos analis-las uma a uma. Na parte superior da tela temos a barra de navegao, nela podemos navegar pelos registros, indo ao prximo ou anterior, e tambm pulando para o primeiro ou ltimo registro.

Na rea inferior da tela, temos os botes:

Usa do

Usa do

Usa do

Na tela de cadastro, na parte inferior direita, exibido o status da operao, ou seja, qual operao voc est fazendo no momento:

Eo lti

Ao clicarmos no boto 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:

Aps 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. Aps colocar o caminho s clicar no boto backup que a cpia do seu arquivo ser feita no caminho indicado:

A seguir temos o cdigo 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 no confere" TBx_Senha = "" TBx_Senha.SetFocus End If Exit Sub NaoEncontrado: MsgBox "Usurio no 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 opes

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 finalizao do sistema?", vbYesNo + vbQuestion, "Confirmao") = 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 = OPERAO 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 "Percusso" 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

End Sub

GControle Atribuir

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)

End Sub

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

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 excluso?", vbYesNo + vbQuestion, "Confirmao") = 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 operao?", vbYesNo + vbQuestion, "Confirmao") = 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 & " No encontrado.", vbOKOnly + vbCritical, "Resultado da Busca" End If End Sub E com isto encerramos o cdigo que voc dever incluir no projeto usando o Editor de Cdigos do Visual Basic do Excel. Hasta la vista... Jos Carlos Macoratti