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 : Bibliotecaescolar011
Quer receber novidades e e-books gratuitos?

FILTRO DE TUTORIAIS:


Criando Aplicativo Para Biblioteca Escolar. Conclusão

 

Objetivo:

 

Nesta parte iremos aprender a inserir os códigos nos formulários Form_Reservas, Form_Reserva, Form_Empréstimos, Form_Empréstimo, Form_Devolução, Opções_ajuda e Ajuda, também vamos alterar algumas propriedades dos objetos e inserir as opções de ajuda direto no banco de dados.

 

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 Parte 1 e Parte 2, juntamente com as partes 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 anteriores da criação da biblioteca escolar.

 

Nota:

 

Irei mostrar como deve ser inserido os códigos no aplicativo de forma direta, ou seja, nos botões de comando e nos formulários, sendo que alguns casos você vai repetir os mesmos procedimentos, lembrando para acessar a janela de código clique duas vezes sobro o objeto formulário ou botão.

Vamos começar a codificar o form_Reservas, inseria o código abaixo, que vai ser para os filtros nome e de livros no formulário, sendo que na janela de código você deve selecionar o evento Initialize, este evento vai fazer com que na hora que o iniciarmos o aplicativo o mesmo aciona o nome do cabeçalho na grade.Também vamos inserir um código para a label que terá a função de verificar quantos registros tem no banco de dados.

 

Vou mostrar como deve fazer este procedimento, depois você deve seguir estes procedimentos para o outros formulários:

 

Ative a janela de código do formulário e no canto direito superior da janela selecione a opção initialize:

 

Tela 001 (Selecione a opção initialize)

 

Selecionado esta opção você deve inserir o seguinte código:

 

Tela 002

 

Clicando em referencias vai abrir uma janela onde deve selecionar a biblioteca e clicar em ok para confirmação.

 

Grade.ColWidth(0) = 800

Grade.ColWidth(1) = 2800

 

 

Grade.Row = 0

Grade.Col = 0

Grade.CellAlignment = 4

Grade.Text = "COD"

 

Grade.Col = 1

Grade.CellAlignment = 4

Grade.Text = "NOME"

 

'SEGUNDA GRADE

 

Grade1.ColWidth(0) = 800

Grade1.ColWidth(1) = 2800

 

 

Grade1.Row = 0

Grade1.Col = 0

Grade1.CellAlignment = 4

Grade1.Text = "COD"

 

Grade1.Col = 1

Grade1.CellAlignment = 4

Grade1.Text = "TITULO"

 

Após ter feito isso, volte ao formulário e clique sobre a grade Filtro de Nomes e coloque o nome Grade, para isso selecione a propriedade Name e modifique para o nome citado acima.

 

Na segunda grade você deve fazer o mesmo procedimento só deve colocar o nome de Grade1.

 

Vamos inserir o código abaixo dentro do campo Text_Nome, dentro do evento Exit, para selecionar este evento siga o mesmo procedimento ensinado para acessar o evento Initialize, este text é que faz referência ao nome, você também deve inserir outro textBox, neste selecione a propriedade enabled e coloque false, isso vai fazer com que este text não apareça quando o aplicativo estiver ativado.

 

Label09 = Application.WorksheetFunction.CountA(Plan5.Columns(1)) - 1

 

 

Dim DB As Database

Dim rs As Recordset

 

If Me.Text_codigo = 3 Then

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 & "'"

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade.Row = Grade.Rows - 1 Then

Grade.Rows = Grade.Rows + 1

End If

Grade.Row = Grade.Row + 1

Grade.Col = 0

Grade.Text = rs("COD")

Grade.Col = 1

Grade.Text = rs("NOME")

rs.MoveNext

Wend

End If

ElseIf Me.Text_codigo = 2 Then

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 & "'"

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade.Row = Grade.Rows - 1 Then

Grade.Rows = Grade.Rows + 1

End If

Grade.Row = Grade.Row + 1

Grade.Col = 0

Grade.Text = rs("COD")

Grade.Col = 1

Grade.Text = rs("NOME")

rs.MoveNext

Wend

End If

End If

 

Agora dentro do campo assunto insira o seguinte código:

 

 

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 & "'"

 

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade1.Row = Grade1.Rows - 1 Then

Grade1.Rows = Grade1.Rows + 1

End If

Grade1.Row = Grade1.Row + 1

Grade1.Col = 0

Grade1.Text = rs("COD")

Grade1.Col = 1

Grade1.Text = rs("TITULO")

rs.MoveNext

Wend

End If

 

Agora vamos inserir os códigos nos botões de comando primeiro no Botão Ver Reserva:

 

Form_RESERVA.Show

 

Agora no botão Reservar:

 

If Me.Text_ASSUNTO <> "" Then

 

Form_RESERVA.Text_TESTABD.Text = Me.Text_COD.Text

 

End If

 

If Form_RESERVA.Text_CANCELACADASTRO = "" Then

 

 

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("plan5$", dbOpenDynaset)

 

 

Dim CADASTRO(1 To 12)

CADASTRO(1) = UCase(Me.Text_codigo)

CADASTRO(2) = UCase(Me.Text_NOME)

CADASTRO(3) = UCase(Me.Text_COD)

CADASTRO(4) = UCase(Me.Text_ASSUNTO)

CADASTRO(5) = UCase(Me.Text_TITULO)

CADASTRO(6) = UCase(Me.Text_EMPRESTIMO)

CADASTRO(6) = UCase(Me.Text_COD.Value)

Dim biblioteca As Object

Dim L, I

Set biblioteca = Plan5.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

Plan5.Cells(L, I).Value = Trim(CADASTRO(I))

Next I

MsgBox "CADASTRADO", vbInformation, "EFETUADO COM SUCESSO"

ThisWorkbook.Save

End If

Exit Sub

 

Else

 

MsgBox "LIVRO JÁ RESERVADO"

 

Exit Sub

 

End If

 

Por último insira o código abaixo no botão voltar:

 

FORM_RESERVAS.Hide

 

Agora vamos inserir os códigos no formulário Form_Reserva, primeiro no Botão pesquisar inserindo o código abaixo.

 

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("plan5$", dbOpenDynaset)

rs.FindFirst "NOME LIKE'" & Me.Text_NOME & "'"

 

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade1.Row = Grade1.Rows - 1 Then

Grade1.Rows = Grade1.Rows + 1

End If

Grade1.Row = Grade1.Row + 1

Grade1.Col = 0

Grade1.Text = rs("COD")

Grade1.Col = 1

Grade1.Text = rs("NOME")

Grade1.Col = 2

Grade1.Text = rs("CODLIVRO")

Grade1.Col = 3

Grade1.Text = rs("ASSUNTO")

Grade1.Col = 4

Grade1.Text = rs("TITULO")

Grade1.Col = 5

Grade1.Text = rs("DTAEMPRESTIMO")

rs.MoveNext

Wend

End If

 

Agora coloque o código abaixo no botão voltar.

 

Form_RESERVA.Hide

Exit Sub

 

Vamos codificar os textbox Verificar Reserva o qual tem o nome na sua propriedade name de TestaBd, insira o seguinte código:

 

If Me.Text_TESTABD <> "" Then

 

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("plan5$", dbOpenDynaset)

rs.FindFirst "COD LIKE'" & Me.Text_TESTABD & "'"

 

If rs.NoMatch = True Then MsgBox "Confirmar Dados", vbInformation, "Banco dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade1.Row = Grade1.Rows - 1 Then

Grade1.Rows = Grade1.Rows + 1

End If

Grade1.Row = Grade1.Row + 1

Grade1.Col = 0

Grade1.Text = rs("COD")

Grade1.Col = 1

Grade1.Text = rs("NOME")

Grade1.Col = 2

Grade1.Text = rs("CODLIVRO")

Grade1.Col = 3

Grade1.Text = rs("ASSUNTO")

Grade1.Col = 4

Grade1.Text = rs("TITULO")

Grade1.Col = 5

Grade1.Text = rs("DTAEMPRESTIMO")

rs.MoveNext

Wend

End If

 

 

Me.Text_CANCELACADASTRO.Text = 1

Form_RESERVA.Show

End If

 

Pronto, terminamos de codificar o Form_Reserva, sendo assim concluímos toda a parte de reservas de livros, agora a parte de empréstimo de livros é quase o mesmo procedimento visto nesta parte.Portando vou apenas mostrar o código a ser inserido.

 

Vamos começar a codificar o Form_ Empréstimos insira o seguinte código no formulário dentro do evento initialize:

 

Label52 = Application.WorksheetFunction.CountA(Plan6.Columns(1)) - 1

 

 

Grade.ColWidth(0) = 800

Grade.ColWidth(1) = 2800

 

 

Grade.Row = 0

Grade.Col = 0

Grade.CellAlignment = 4

Grade.Text = "COD"

 

Grade.Col = 1

Grade.CellAlignment = 4

Grade.Text = "NOME"

 

'ESTE ABAIXO FAZ PARTE DA GRADE DE LIVROS

 

Grade1.ColWidth(0) = 800

Grade1.ColWidth(1) = 2800

 

 

Grade1.Row = 0

Grade1.Col = 0

Grade1.CellAlignment = 4

Grade1.Text = "COD"

 

Grade1.Col = 1

Grade1.CellAlignment = 4

Grade1.Text = "TITULO"

 

Ative o formulário novamente e coloque os nomes os mesmos nomes nas grades que colocamos no formulário reservas, ou seja, para a primeira coloque grade e para a segunda Grade1.

 

Depois no campo Nome dentro do Text_Nome insira o código:

 

Dim DB As Database

Dim rs As Recordset

 

If Me.Text_CODIGO = 3 Then

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 & "'"

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade.Row = Grade.Rows - 1 Then

Grade.Rows = Grade.Rows + 1

End If

Grade.Row = Grade.Row + 1

Grade.Col = 0

Grade.Text = rs("COD")

Grade.Col = 1

Grade.Text = rs("NOME")

rs.MoveNext

Wend

End If

ElseIf Me.Text_CODIGO = 2 Then

 

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 & "'"

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade.Row = Grade.Rows - 1 Then

Grade.Rows = Grade.Rows + 1

End If

Grade.Row = Grade.Row + 1

Grade.Col = 0

Grade.Text = rs("COD")

Grade.Col = 1

Grade.Text = rs("NOME")

rs.MoveNext

Wend

End If

 

End If

Dentro do campo assunto no text_assunto insira o código:

 

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 & "'"

 

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade1.Row = Grade1.Rows - 1 Then

Grade1.Rows = Grade1.Rows + 1

End If

Grade1.Row = Grade1.Row + 1

Grade1.Col = 0

Grade1.Text = rs("COD")

Grade1.Col = 1

Grade1.Text = rs("TITULO")

rs.MoveNext

Wend

End If

 

Agora vamos codificar os três botões de comando:

 

Botão Emprestar:

 

 

If Me.Text_ASSUNTO <> "" Then

 

Form_EMPRESTIMO.Text_TESTABD.Text = Me.Text_COD.Text

 

End If

 

If Form_EMPRESTIMO.Text_CANCELACADASTRO = "" Then

 

 

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("plan6$", dbOpenDynaset)

 

 

Dim CADASTRO(1 To 12)

CADASTRO(1) = UCase(Me.Text_CODIGO)

CADASTRO(2) = UCase(Me.Text_NOME)

CADASTRO(3) = LCase(Me.Text_COD)

CADASTRO(4) = UCase(Me.Text_ASSUNTO)

CADASTRO(5) = UCase(Me.Text_TITULO)

CADASTRO(6) = UCase(Me.Text_EMPRESTIMO)

CADASTRO(6) = UCase(Me.Text_COD.Value)

Dim biblioteca As Object

Dim L, I

Set biblioteca = Plan6.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

Plan6.Cells(L, I).Value = Trim(CADASTRO(I))

Next I

MsgBox "CADASTRADO", vbInformation, "EFETUADO COM SUCESSO"

ThisWorkbook.Save

End If

Exit Sub

 

 

Else

 

MsgBox "LIVRO JÁ EMPRESTADO"

 

Exit Sub

 

End If

 

Botão Ver Empréstimo:

 

Form_EMPRESTIMO.Show

 

Botão Voltar:

 

FORM_EMPRESTIMOS.Hide

 

Terminado a parte de codificação deste formulários vamos para o próximo que será o Form_Empréstimo, codificaremos primeiro os botões de comando:

 

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("plan6$", dbOpenDynaset)

rs.FindFirst "NOME LIKE'" & Me.Text_NOME & "'"

 

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade1.Row = Grade1.Rows - 1 Then

Grade1.Rows = Grade1.Rows + 1

End If

Grade1.Row = Grade1.Row + 1

Grade1.Col = 0

Grade1.Text = rs("COD")

Grade1.Col = 1

Grade1.Text = rs("NOME")

Grade1.Col = 2

Grade1.Text = rs("CODLIVRO")

Grade1.Col = 3

Grade1.Text = rs("ASSUNTO")

Grade1.Col = 4

Grade1.Text = rs("TITULO")

Grade1.Col = 5

Grade1.Text = rs("DTAEMPRESTIMO")

rs.MoveNext

Wend

End If

 

Botão Voltar:

 

Form_EMPRESTIMO.Hide

 

Agora iremos codificar os textbox Verifica Empréstimo:

 

If Me.Text_TESTABD <> "" Then

 

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("plan6$", dbOpenDynaset)

rs.FindFirst "COD LIKE'" & Me.Text_TESTABD & "'"

 

If rs.NoMatch = True Then MsgBox "Confirmar Dados", vbInformation, "Banco dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade1.Row = Grade1.Rows - 1 Then

Grade1.Rows = Grade1.Rows + 1

End If

Grade1.Row = Grade1.Row + 1

Grade1.Col = 0

Grade1.Text = rs("COD")

Grade1.Col = 1

Grade1.Text = rs("NOME")

Grade1.Col = 2

Grade1.Text = rs("CODLIVRO")

Grade1.Col = 3

Grade1.Text = rs("ASSUNTO")

Grade1.Col = 4

Grade1.Text = rs("TITULO")

Grade1.Col = 5

Grade1.Text = rs("DTAEMPRESTIMO")

rs.MoveNext

Wend

End If

 

 

Me.Text_CANCELACADASTRO.Text = 1

Form_EMPRESTIMO.Show

 

 

Pronto, terminamos de concluir toda a codificação da parte empréstimos, vamos codificar o formulário de Devolução.

 

Dentro do formulário no evento initialize coloque o código abaixo e na grade coloque o nome de Grade1.

 

Grade1.ColWidth(0) = 800

Grade1.ColWidth(1) = 2800

 

 

Grade1.Row = 0

Grade1.Col = 0

Grade1.CellAlignment = 4

Grade1.Text = "COD"

 

Grade1.Col = 1

Grade1.CellAlignment = 4

Grade1.Text = "TITULO"

 

Dentro do TextBox Nome no evento Exit coloque o seguinte código:

 

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("plan6$", dbOpenDynaset)

rs.FindFirst "NOME LIKE'" & Me.Text_NOME & "'"

 

If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub

If rs.EOF = False Then

While rs.EOF = False

If Grade1.Row = Grade1.Rows - 1 Then

Grade1.Rows = Grade1.Rows + 1

End If

Grade1.Row = Grade1.Row + 1

Grade1.Col = 0

Grade1.Text = rs("COD")

Grade1.Col = 1

Grade1.Text = rs("NOME")

rs.MoveNext

Wend

End If

 

Dentro do Botão Efetuar Devolução ensira o código:

 

Dim biblioteca

agenda = MsgBox("DESEJA REALMENTE EXCLUIR O REGISTRO", vbYesNo + vbQuestion, "CADASTRO DE ENDEREÇOS")

If agenda = vbYes Then

Plan6.Cells(Val(Me.Text_COD) + 1, 1).EntireRow.Delete

ThisWorkbook.Save

End If

 

 

Dentro do botão voltar insira o seguinte código:

 

FORM_DEVOLUCAO.Hide

 

Pronto acabamos de codificar o formulário de devolução de livros.

 

 

Agora vamos inserir os códigos no formulário Opcoes_Ajuda.

 

 

Dentro de cada optionButtom referente a cadastro você deve colocar o seguinte código seguindo esta ordem:

 

Dentro do OptionButtom Cadastro de Professores :

 

AJUDA.Text_COD1 = "1"

AJUDA.Show

 

Dentro do OptionButtom Cadastro de Alunos :

 

AJUDA.Text_COD1 = "2"

AJUDA.Show

 

Dentro do OptionButtom Cadastro de Livros:

 

AJUDA.Text_COD1 = "3"

AJUDA.Show

 

Dentro do OptionButtom Cadastro de Reserva de Livros :

 

AJUDA.Text_COD1 = "4"

AJUDA.Show

 

Dentro do OptionButtom Cadastro de Empréstimo de Livros :

 

AJUDA.Text_COD1 = "5"

AJUDA.Show

 

 

Dentro de cada optionButtom referente a pesquisa você deve colocar o seguinte código seguindo esta ordem:

 

Dentro do OptionButtom Pesquisa de Professores :

 

AJUDA.Text_COD1 = "6"

AJUDA.Show

 

Dentro do OptionButtom Pesquisa de Alunos :

 

AJUDA.Text_COD1 = "7"

AJUDA.Show

 

Dentro do OptionButtom Pesquisa de Livros:

 

AJUDA.Text_COD1 = "8"

AJUDA.Show

 

Dentro do OptionButtom Pesquisa de Reserva de Livros :

 

AJUDA.Text_COD1 = "9"

AJUDA.Show

 

Dentro do OptionButtom Pesquisa de Empréstimo de Livros :

 

AJUDA.Text_COD1 = "10"

AJUDA.Show

 

Dentro de cada optionButtom referente a editar voce deve colocar o seguinte código seguindo esta ordem:

 

Dentro do OptionButtom Editar Professores :

 

AJUDA.Text_COD1 = "11"

AJUDA.Show

 

Dentro do OptionButtom Editar Alunos :

 

AJUDA.Text_COD1 = "12"

AJUDA.Show

 

Dentro do OptionButtom Editar Livros:

 

AJUDA.Text_COD1 = "13"

AJUDA.Show

 

Dentro de cada optionButtom referente apagar você deve colocar o seguinte código seguindo esta ordem:

 

Dentro do OptionButtom Apagar Professores :

 

AJUDA.Text_COD1 = "14"

AJUDA.Show

 

Dentro do OptionButtom Apagar Alunos :

 

AJUDA.Text_COD1 = "15"

AJUDA.Show

 

Dentro do OptionButtom Apagar Livros:

 

AJUDA.Text_COD1 = "16"

AJUDA.Show

 

 

Dentro do OptionButtom Apagar Devolução:

 

AJUDA.Text_COD1 = "17"

AJUDA.Show

 

Terminado a codificação deste formulário vamos inserir os seguintes códigos no formulário Ajuda, insira os códigos dentro do textbox que deve ter o nome na sua propriedade name de Text_COD1, sendo que você deve repetir este mesmo código dezessete vezes, apenas modificando a linha de código If me.text_cod1=”1” then.

 

If Me.Text_COD1 = "1" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

If Me.Text_COD1 = "2" Then

 

Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")

Set rs = BD.OpenRecordset("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

 

If Me.Text_COD1 = "3" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

 

If Me.Text_COD1 = "4" Then

 

Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")

Set rs = BD.OpenRecordset("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

End If

 

 

If Me.Text_COD1 = "5" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

If Me.Text_COD1 = "6" Then

 

Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")

Set rs = BD.OpenRecordset("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

 

 

If Me.Text_COD1 = "7" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

If Me.Text_COD1 = "8" Then

 

Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")

Set rs = BD.OpenRecordset("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

 

If Me.Text_COD1 = "9" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

If Me.Text_COD1 = "10" Then

 

Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")

Set rs = BD.OpenRecordset("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

End If

 

If Me.Text_COD1 = "11" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

If Me.Text_COD1 = "12" Then

 

Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")

Set rs = BD.OpenRecordset("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

 

If Me.Text_COD1 = "13" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

 

If Me.Text_COD1 = "14" Then

 

Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")

Set rs = BD.OpenRecordset("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

If Me.Text_COD1 = "15" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

If Me.Text_COD1 = "16" Then

 

Set BD = OpenDatabase("C:\Meus documentos\APLICATIVO\BIBLIOTECA\BIBLIOTECAESCOLAR.xls", False, False, "excel 8.0")

Set rs = BD.OpenRecordset("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

If Me.Text_COD1 = "17" Then

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("plan7$", dbOpenDynaset)

 

 

rs.FindFirst "COD LIKE'" & Me.Text_COD1 & "'"

'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_RECEBE = rs.Fields("DESCRICAO")

End If

 

Obs: Este Text_cod você deve alterar a propriedade enabled para false.

 

Vamos codificar o botão voltar:

 

AJUDA.Hide

 

Pronto terminamos de codificar todo o aplicativo, agora vamos inserir as descrições de ajuda direto no bando de dados, vou mostrar apenas como você deve fazer a primeira descrição já que as outras é o mesmo processo. Quero também ressaltar que este procedimento de ajuda é bem simples e você pode alterar.

 

A seguir vou descrever as descrições e depois vou ensinar como deve ser colocado no banco de dados:

 

Cód = 1 CADASTRO DE PROFESSORES: Preencha todos os campos, sendo que no campo código você deve digitar um número maior do que esta no campo Registros,isso se faz necessário para não repetir no banco de dados o mesmo número de registro. CADASTRO PROFESSORES: Preencha todos os campos,sendo que no campo código você deve digitar um número maior do que esta no campo Registros,isso se faz necessário para não repetir no banco de dados o mesmo número de registro.

 

Cód= 2 CADASTRO DE ALUNOS: Preencha todos os campos e no campo código você deve digitar um número maior do que esta no campo Registro.

 

Cód = 3 CADASTRO DE LIVROS: Preencha os campos sempre colocando um número maior no campo código para que seja efetuado o registro.

 

 

Cód= 4 CADASTRO DE EMPRESTIMO DE LIVROS: Você deve preencher todos os campos, podendo fazer uma busca de nomes e de livros da seguinte maneira:

Você deve efetuar uma busca pelo nome das pessoas, no campo código você de digitar 2 para acessar o banco de dados de professores mais o nome da pessoa e para acessar o banco de dados de alunos digite 3 mais o nome, fazendo isso vai aparecer um ou mais nomes no filtro correspondente devendo você selecionar e escrever o código correto ao nome.

 

Cód= 5 CADASTRO DE EMPRESTIMO DE LIVROS: Você deve preencher todos os campos, podendo fazer uma busca de nomes e de livros da seguinte maneira:

Você deve efetuar uma busca pelo nome das pessoas, no campo código você de digitar 2 para acessar o banco de dados de professores mais o nome da pessoa e para acessar o banco de dados de alunos digite 3 mais o nome, fazendo isso vai aparecer um ou mais nomes no filtro correspondente devendo você selecionar e escrever o código correto ao nome.

 

Cód = 6 PESQUISA DE PROFESSORES: Para efetuar uma pesquisa basta digitar o nome da pessoa no campo Nome e clicar em pesquisar.

 

Cód = 7 PESQUISA DE LIVROS: Para efetuar uma pesquisa basta digitar o nome da pessoa no campo Nome e clicar em pesquisar.

 

Cód= 8 PESQUISA DE ALUNOS: Para efetuar uma pesquisa basta digitar o nome da pessoa no campo Nome e clicar em pesquisar.

 

Cód = 9 RESERVA DE LIVROS: No campo assunto digite o nome do mesmo e clique em pesquisar.

 

Cód = 10 EMPRESTIMO DE LIVROS: No campo assunto digite o nome do mesmo e clique em pesquisar.

 

Cód= 11 EDITAR PROFESSORES: Faça uma busca normal, depois altere os campos desejados e por ultimo clique no botão editar.

 

Cód= 12 EDITAR ALUNOS: Faça uma busca normal, depois altere os campos desejados e por ultimo clique no botão editar.

 

Cód = 13 EDITAR LIVROS: Faça uma busca normal, depois altere os campos desejados e por ultimo clique no botão editar.

 

Cód = 14 APAGAR PROFESSORES: Efetue uma busca e clique no botão apagar.

 

Cód = 15 APAGAR ALUNOS: Faça uma busca normal, depois altere os campos desejados e por ultimo clique no botão editar.

 

Cód = 16 APAGAR LIVROS: Faça uma busca normal, depois altere os campos desejados e por ultimo clique no botão editar.

 

Cód = 17 DEVOLUÇÃO: Digite o nome e depois coloque o número correspondente ao nome no campo código e clique em efetuar devolução

 

Agora vamos colocar estas descrições no banco de dados de ajuda, abra o banco de dados que em nossa planilha corresponde a Plan7.

 

Tela 003

 

Após você deve inserir as descrições na ordem, onde você deve colocar no banco de dados da seguinte maneira:

 

Tela 004

 

Pronto basta seguir o mesmo procedimento para as demais explicações.

 

Conclusão:

 

Concluímos o aplicativo, nesta parte ensinei a codificar os formulários Form_Reservas, Form_Reserva, Form_Empréstimos, Form_Empréstimo, Form_Devolução, Opções_ajuda e Ajuda, também a inserir as descrições de ajuda no banco de dados, até o próximo aplicativo que vai ser controle de fax.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