NUNCA MAIS PASSE RAIVA POR NÃO CONSEGUIR RESOLVER UM PROBLEMA COM O EXCEL - GARANTIDO!
UNIVERSIDADE DO VBA - Domine o VBA no Excel Criando Sistemas Completos - Passo a Passo - CLIQUE AQUI
Objetivo:
Vamos dividir a parte de codificação em duas, nesta parte iremos aprender a inserir os códigos nos formulários de Principal, Opções de Cadastro, Cadastro Alunos, Cadastro de Professores e Cadastro de livros no aplicativo biblioteca escolar, também ativar a biblioteca Microsoft Dao 3.51.
Pré-requisito:
Para você poder acompanhar o desenvolvimento deste tutorial, será necessário ter conhecimento no mínimo do “Curso Básico de Excel e os Tutoriais Utilizando Editor do Visual Basic do Excel Parte1 e Parte2, juntamente com as partes 1,2,3,4,5,6,7,8,9 anteriores da criação da biblioteca escolar.”
Nota:
Irei mostrar como deve ser inserido os códigos no aplicativo, ou seja, nos botões de comando e nos formulários, lembrando para acessar a janela de código clique duas vezes sobro o objeto formulário ou botão.
Antes de codificar o aplicativo, devemos ativar uma referência do Excel chamado Microsoft DAO 3.51 Object Library, este objeto é uma biblioteca, para ativa-la sigas os procedimentos:
Com o aplicativo aberto, ou seja, o editor de vba, clique no menu ferramentas e depois em referências.
Tela 001
Clicando em referencias vai abrir uma janela onde deve selecionar a biblioteca e clicar em ok para confirmação.
Tela 002
Terminado a ativação desta biblioteca, vamos começar a inserir o código no aplicativo, vamos começar pelo formulário principal, coloque os códigos abaixo os deverão ser inseridos dentro de cada botão, ou seja, dentro da janela de código seguindo os procedimentos:
Botão Cadastrar :
OPCOES_CADASTRO.Show
Botão Reservar:
FORM_RESERVAS.Show
Botão Empréstimos:
FORM_EMPRESTIMOS.Show
Botão Devolução:
FORM_DEVOLUCAO.Show
Botão de Ajuda:
OPCOES_AJUDA.Show
Botão Fechar:
PRINCIPAL.Hide
Este código inserido em cada um dos botões tem a função de abrir os outros formulários excetos o botão fechar que tem a função de fechar o aplicativo.
O Próximo formulário que iremos inserir os códigos será o Opções_Cadastro, neste vamos inserir três códigos nos optionButton.
Optionbutton 1 Professores:
CADASTRO_PROFESSORES.Show
0ptionbutton 2 Alunos:
CADASTRO_ALUNOS.Show
Optionbutton 2 Livros:
CADASTRO_LIVROS.Show
O próximo formulário a ser cadastrado será o de Alunos, insira os códigos dentro de cada botão seguindo os procedimentos abaixo:
Botão Cadastrar:
Dim BD As Database
Dim rs As Recordset
Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")
Set rs = BD.OpenRecordset("plan2$", dbOpenDynaset)
If Me.Text_CODIGO > Me.Label11 Then
Dim CADASTRO(1 To 12)
CADASTRO(1) = UCase(Me.Text_CODIGO)
CADASTRO(2) = UCase(Me.Text_NOME)
CADASTRO(3) = LCase(Me.Text_ENDEREC0)
CADASTRO(4) = UCase(Me.Text_NRO)
CADASTRO(5) = UCase(Me.Text_BAIRRO)
CADASTRO(6) = UCase(Me.Text_CEP)
CADASTRO(7) = UCase(Me.Text_CALULAR)
CADASTRO(8) = UCase(Me.Text_RESIDENCIA)
CADASTRO(9) = UCase(Me.Text_TURMA)
CADASTRO(10) = UCase(Me.Text_SERIE)
CADASTRO(11) = UCase(Me.Text_TURNO)
CADASTRO(12) = UCase(Me.Text_SALA)
CADASTRO(12) = UCase(Me.Text_CODIGO.Value)
Dim biblioteca As Object
Dim L, I
Set biblioteca = Plan2.Cells(1, 1).CurrentRegion
L = biblioteca.Rows.Count + 1
If Len(Me.Text_CODIGO) = 0 Then
MsgBox "VOCÊ NÃO DIGITOU NOME EM NENHUM DOS CAMPOS PARA INCLUSÃO", vbCritical, "CADASTRO DE ENDEREÇOS"
Else
For I = 1 To 12
Plan2.Cells(L, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "CADASTRADO", vbInformation, "EFETUADO COM SUCESSO"
ThisWorkbook.Save
End If
Exit Sub
Else
MsgBox "No campo CODIGO digite um número maior do que há no campo REGISTRO para efetuar o cadastro."
Botão Pesquisar:
Dim DB As Database
Dim rs As Recordset
Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")
Set rs = BD.OpenRecordset("plan2$", dbOpenDynaset)
rs.FindFirst "NOME LIKE'" & Me.Text_NOME & "'"
'3º se não tiver o registro na tabela termina pesquisa
If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub
'4º se localizar pesquisa preenche os campos
Me.Text_CODIGO = rs.Fields("COD")
Me.Text_NOME = rs.Fields("NOME")
Me.Text_ENDEREC0 = rs.Fields("ENDERECO")
Me.Text_NRO = rs.Fields("NRO")
Me.Text_BAIRRO = rs.Fields("BAIRRO")
Me.Text_CEP = rs.Fields("CEP")
Me.Text_CALULAR = rs.Fields("CELULAR")
Me.Text_RESIDENCIA = rs.Fields("RESIDENCIAL")
Me.Text_TURMA = rs.Fields("TURMA")
Me.Text_SERIE = rs.Fields("SERIE")
Me.Text_TURNO = rs.Fields("TURNO")
Me.Text_SALA = rs.Fields("SALA")
Botão Editar:
Dim CADASTRO(1 To 12)
CADASTRO(1) = UCase(Me.Text_CODIGO)
CADASTRO(2) = UCase(Me.Text_NOME)
CADASTRO(3) = LCase(Me.Text_ENDEREC0)
CADASTRO(4) = UCase(Me.Text_NRO)
CADASTRO(5) = UCase(Me.Text_BAIRRO)
CADASTRO(6) = UCase(Me.Text_CEP)
CADASTRO(7) = UCase(Me.Text_CALULAR)
CADASTRO(8) = UCase(Me.Text_RESIDENCIA)
CADASTRO(9) = UCase(Me.Text_TURMA)
CADASTRO(10) = UCase(Me.Text_SERIE)
CADASTRO(11) = UCase(Me.Text_TURNO)
CADASTRO(12) = UCase(Me.Text_SALA)
CADASTRO(12) = UCase(Me.Text_CODIGO.Value)
For I = 1 To 12
Plan2.Cells(Val(Me.Text_CODIGO) + 1, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "ALTERAÇÃO EFETUADA", vbInformation, "CADASTRO DE ENDEREÇOS"
ThisWorkbook.Save
Botão Apagar:
Dim biblioteca
agenda = MsgBox("DESEJA REALMENTE EXCLUIR O REGISTRO", vbYesNo + vbQuestion, "CADASTRO DE ENDEREÇOS")
If agenda = vbYes Then
Plan2.Cells(Val(Me.Text_COD) + 1, 1).EntireRow.Delete
ThisWorkbook.Save
Universidade do VBA - Curso Completo, com Certificado e com Atualizações Semanais
Domine, sem Dificuldades, a Programação VBA no Excel, Através da Criação de Sistemas Profissionais Completos - Com Exemplos Práticos e Explicações Detalhadas - Passo a Passo - Tela a Tela - Comando a Comando!
Aplica-se ao Excel 2019, 2016, 2013 e 2010!
Para todos os detalhes, acesse:
Botão Voltar:
CADASTRO_ALUNOS.Hide
O próximo formulário que iremos inserir os códigos será Cadastro de Professores.
Botão Cadastrar:
Dim BD As Database
Dim rs As Recordset
Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")
Set rs = BD.OpenRecordset("plan3$", dbOpenDynaset)
If Me.Text_CODIGO > Me.Label24 Then
Dim CADASTRO(1 To 12)
CADASTRO(1) = UCase(Me.Text_CODIGO)
CADASTRO(2) = UCase(Me.Text_NOME)
CADASTRO(3) = LCase(Me.Text_endereco)
CADASTRO(4) = UCase(Me.Text_nro)
CADASTRO(5) = UCase(Me.Text_bairro)
CADASTRO(6) = UCase(Me.Text_cep)
CADASTRO(7) = UCase(Me.Text_celular)
CADASTRO(8) = UCase(Me.Text_residencia)
CADASTRO(8) = UCase(Me.Text_CODIGO.Value)
Dim biblioteca As Object
Dim L, I
Set biblioteca = Plan3.Cells(1, 1).CurrentRegion
L = biblioteca.Rows.Count + 1
If Len(Me.Text_CODIGO) = 0 Then
MsgBox "VOCÊ NÃO DIGITOU NOME EM NENHUM DOS CAMPOS PARA INCLUSÃO", vbCritical, "CADASTRO DE ENDEREÇOS"
Else
For I = 1 To 8
Plan3.Cells(L, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "CADASTRADO", vbInformation, "EFETUADO COM SUCESSO"
ThisWorkbook.Save
End If
Exit Sub
Else
MsgBox "No campo CODIGO digite um número maior do que há no campo REGISTRO para efetuar o cadastro."
End If
Botão Pesquisar
Dim DB As Database
Dim rs As Recordset
Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")
Set rs = BD.OpenRecordset("plan3$", dbOpenDynaset)
rs.FindFirst "NOME LIKE'" & Me.Text_NOME & "'"
'3º se não tiver o registro na tabela termina pesquisa
If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub
'4º se localizar pesquisa preenche os campos
Me.Text_CODIGO = rs.Fields("COD")
Me.Text_NOME = rs.Fields("NOME")
Me.Text_endereco = rs.Fields("ENDERECO")
Me.Text_nro = rs.Fields("NRO")
Me.Text_bairro = rs.Fields("BAIRRO")
Me.Text_cep = rs.Fields("CEP")
Me.Text_celular = rs.Fields("CELULAR")
Me.Text_residencia = rs.Fields("RESIDENCIAL")
Botão Editar
Dim BD As Database
Dim rs As Recordset
Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")
Set rs = BD.OpenRecordset("plan3$", dbOpenDynaset)
Dim CADASTRO(1 To 8)
CADASTRO(1) = UCase(Me.Text_CODIGO)
CADASTRO(2) = UCase(Me.Text_NOME)
CADASTRO(3) = LCase(Me.Text_endereco)
CADASTRO(4) = UCase(Me.Text_nro)
CADASTRO(5) = UCase(Me.Text_bairro)
CADASTRO(6) = UCase(Me.Text_cep)
CADASTRO(7) = UCase(Me.Text_celular)
CADASTRO(8) = UCase(Me.Text_residencia)
CADASTRO(8) = UCase(Me.Text_CODIGO.Value)
For I = 1 To 8
Plan3.Cells(Val(Me.Text_CODIGO) + 1, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "ALTERAÇÃO EFETUADA", vbInformation, "CADASTRO DE ENDEREÇOS"
ThisWorkbook.Save
Botão Apagar
Dim biblioteca
agenda = MsgBox("DESEJA REALMENTE EXCLUIR O REGISTRO", vbYesNo + vbQuestion, "CADASTRO DE ENDEREÇOS")
If agenda = vbYes Then
Plan3.Cells(Val(Me.Text_COD) + 1, 1).EntireRow.Delete
ThisWorkbook.Save
End If
Botão Voltar:
CADASTRO_PROFESSORES.Hide
Vamos codificar o Cadastro de Livros.
Botão Cadastrar
Dim BD As Database
Dim rs As Recordset
Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")
Set rs = BD.OpenRecordset("plan4$", dbOpenDynaset)
If Me.Text_COD > Me.Label36 Then
Dim CADASTRO(1 To 12)
CADASTRO(1) = UCase(Me.Text_COD)
CADASTRO(2) = UCase(Me.Text_autor)
CADASTRO(3) = LCase(Me.Text_ASSUNTO)
CADASTRO(4) = UCase(Me.Text_TITULO)
CADASTRO(5) = UCase(Me.Text_editora)
CADASTRO(5) = UCase(Me.Text_COD.Value)
Dim biblioteca As Object
Dim L, I
Set biblioteca = Plan4.Cells(1, 1).CurrentRegion
L = biblioteca.Rows.Count + 1
If Len(Me.Text_COD) = 0 Then
MsgBox "VOCÊ NÃO DIGITOU NOME EM NENHUM DOS CAMPOS PARA INCLUSÃO", vbCritical, "CADASTRO DE ENDEREÇOS"
Else
For I = 1 To 12
Plan4.Cells(L, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "CADASTRADO", vbInformation, "EFETUADO COM SUCESSO"
ThisWorkbook.Save
End If
Exit Sub
Else
MsgBox "No campo CODIGO digite um número maior do que há no campo REGISTRO para efetuar o cadastro."
End If
Botão Pesquisar
Dim DB As Database
Dim rs As Recordset
Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")
Set rs = BD.OpenRecordset("plan4$", dbOpenDynaset)
rs.FindFirst "ASSUNTO LIKE'" & Me.Text_ASSUNTO & "'"
'3º se não tiver o registro na tabela termina pesquisa
If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub
'4º se localizar pesquisa preenche os campos
Me.Text_COD = rs.Fields("COD")
Me.Text_autor = rs.Fields("AUTOR")
Me.Text_ASSUNTO = rs.Fields("ASSUNTO")
Me.Text_TITULO = rs.Fields("TITULO")
Me.Text_editora = rs.Fields("EDITORA")
Botão Editar
Dim CADASTRO(1 To 12)
CADASTRO(1) = UCase(Me.Text_COD)
CADASTRO(2) = UCase(Me.Text_autor)
CADASTRO(3) = LCase(Me.Text_ASSUNTO)
CADASTRO(4) = UCase(Me.Text_TITULO)
CADASTRO(5) = UCase(Me.Text_editora)
CADASTRO(5) = UCase(Me.Text_COD.Value)
For I = 1 To 5
Plan4.Cells(Val(Me.Text_COD) + 1, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "ALTERAÇÃO EFETUADA", vbInformation, "CADASTRO DE ENDEREÇOS"
ThisWorkbook.Save
Botão Apagar
Dim biblioteca
agenda = MsgBox("DESEJA REALMENTE EXCLUIR O REGISTRO", vbYesNo + vbQuestion, "CADASTRO DE ENDEREÇOS")
If agenda = vbYes Then
Plan4.Cells(Val(Me.Text_COD) + 1, 1).EntireRow.Delete
ThisWorkbook.Save
End If
Botão Voltar
CADASTRO_LIVROS.Hide
Concluímos a parte10, nesta parte ensinei a codificar parte do aplicativo e ativar a biblioteca Microsoft DAO 3.51, na próxima parte do tutorial continuaremos a codificar o restante dos formulários .Bons Estudos.
Contato: Telefone: (51) 3717-3796 | E-mail: webmaster@juliobattisti.com.br | Whatsapp: (51) 99627-3434
Júlio Battisti Livros e Cursos Ltda | CNPJ: 08.916.484/0001-25 | Rua Vereador Ivo Cláudio Weigel, 537 - Universitário, Santa Cruz do Sul/RS, CEP: 96816-208
Todos os direitos reservados, Júlio Battisti 2001-2024 ®
LIVRO: MACROS E PROGRAMAÇÃO VBA NO EXCEL 2016 - CURSO COMPLETO E PRÁTICO
DOMINE A PROGRAMAÇÃO VBA NO EXCEL - 878 PÁGINAS - CLIQUE AQUI