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

Você está em: PrincipalTutoriaisInformatizando sua Empresa com Excel : Bibliotecaescolar010
Quer receber novidades e e-books gratuitos?

FILTRO DE TUTORIAIS:


Criando Aplicativo Para Biblioteca Escolar. Parte10

 

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:

 

Formulário Principal

 

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.

 

Formulário Opções_Cadastro

 

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:

 

Formulário Cadastro de Alunos

 

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

 

Botão Voltar:

 

CADASTRO_ALUNOS.Hide

 

O próximo formulário que iremos inserir os códigos será Cadastro de Professores.

 

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.

 

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

Conclusão:

 

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.


Confira todas as partes deste tutorial:

Quer receber novidades e e-books gratuitos?

Cursos Online

  • Banco de Dados
  • Carreira
  • Criação/Web
  • Excel/Projetos
  • Formação
  • + Todas as categorias
  • Essential SSL

    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-2020 ®

    [LIVRO]: MACROS E PROGRAMAÇÃO VBA NO EXCEL 2010 - PASSO-A-PASSO

    APRENDA COM JULIO BATTISTI - 1124 PÁGINAS: CLIQUE AQUI