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
FILTRO DE TUTORIAIS:
Objetivo:
O objetivo deste tutorial e de concluir o sistema para controle de frota de veículos, irei ensinar a codificar todas as interfaces grafica do mesmo.
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 Parte2 e Parte 1, Parte2, Parte3, Parte 4, Parte 5 e Parte 6 deste tutorial”.
Nota: Irei ensinar passo a passo toda codificação da primeira interface do sistemas, as demais irei colocar o codigo para você copiar, sendo é só seguir os mesmos procedimentos para a codificação.
O primeiro procedimento que iremos fazer será ativar a biblioteca Microsoft Dao para que os códigos funcione, para isso, abra o projeto clique sobre a interface motorista, esta é a que irei ensinar passo a passo a codificar.
Quando a mesma estiver ativada clique no menu ferramentas logo em seguida em referências na janela que ira abrir você deve, então, ativar a biblioteca, veja na tela abaixo:
Tela 001
Agora iremos começar a inserir os codigos na interface grafica, este primeiro codigo, será para mostar a quantidade de registros armazenados no banco de dados, iremos inserir o mesmo dentro da propriedade initialize do formulário, clique duas vezes sobre o mesmo para ativar a janela de codigo, sendo que esta propriedade vai fazer com que o código seja ativado asim que o formulário for aberto, veja o codigo abaixo:
Label13 = Application.WorksheetFunction.CountA(Plan1.Columns(1)) – 1
Tela 002
Agora iremos inserir os codigos nos botões, começaremos pelo botão cadastrar, clique duas vezes sobre o mesmo para ativar a janela de codigo, depois copie e cole o codigo abaixo, sendo qe utilizaremos a propriedade click do botão, ou seja, assim que clicarmos será ativado o codigo, que tem a função de cadastrar os registros no banco de dados Motoristas.
Dim bd As Database
Dim rs As Recordset
Set bd = OpenDatabase("C:\Documents and Settings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "excel 8.0")
Set rs = bd.OpenRecordset("Plan1$", dbOpenDynaset)
If Me.Text_Codigo > Me.Label13 Then
If Me.Text_Codigo = "" Then
Me.Text_Codigo.Text = "-"
End If
If Me.Text_bairro.Text = "" Then
Me.Text_bairro.Text = "-"
End If
If Me.Text_telefone.Text = "" Then
Me.Text_telefone.Text = "-"
End If
If Me.Text_cep = "" Then
Me.Text_cep.Text = "-"
End If
If Me.Text_cidade = "" Then
Me.Text_cidade.Text = "-"
End If
If Me.Text_endereco = "" Then
Me.Text_endereco.Text = "-"
End If
If Me.Text_estado = "" Then
Me.Text_estado = "-"
End If
If Me.Text_Nome = "" Then
Me.Text_Nome.Text = "-"
End If
If Me.Text_cpf = "" Then
Me.Text_cpf.Text = "-"
End If
If Me.Text_habilitacao = "" Then
Me.Text_habilitacao.Text = "-"
End If
Dim CADASTRO(1 To 11)
CADASTRO(1) = UCase(Me.Text_Codigo)
CADASTRO(2) = UCase(Me.Text_Nome)
CADASTRO(3) = LCase(Me.Text_endereco)
CADASTRO(4) = UCase(Me.Text_cidade)
CADASTRO(5) = UCase(Me.Text_bairro)
CADASTRO(6) = UCase(Me.Text_estado)
CADASTRO(7) = UCase(Me.Text_cep)
CADASTRO(8) = UCase(Me.Text_telefone)
CADASTRO(9) = UCase(Me.Text_cpf)
CADASTRO(10) = UCase(Me.Text_habilitacao)
CADASTRO(11) = UCase(Me.Text_Codigo.Value)
Dim MOTORISTA As Object
Dim L, I
Set MOTORISTA = Plan1.Cells(1, 1).CurrentRegion
L = MOTORISTA.Rows.Count + 1
If Len(Me.Text_Codigo) = 0 Then
MsgBox "VOCÊ NÃO DIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DE ENDEREÇOS"
Else
For I = 1 To 11
Plan1.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 REGISTRO digite um número maior do que há no campo QTD para casdastrar."
End If
Tela 003
Agora faça o mesmo procedimento para o botão Pesquisar com o codigo abaixo:
Dim DB As Database
Dim rs As Recordset
Set DB = OpenDatabase("C:\Documents and Settings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "Excel 8.0")
Set rs = DB.OpenRecordset("PLAN1$", dbOpenDynaset)
rs.FindFirst "NOME LIKE'" & Me.Text_Nome & "'"
If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub
Me.Text_Codigo = rs.Fields("CODIGO")
Me.Text_Nome = rs.Fields("NOME")
Me.Text_endereco = rs.Fields("ENDERECO")
Me.Text_cidade = rs.Fields("CIDADE")
Me.Text_bairro = rs.Fields("BAIRRO")
Me.Text_estado = rs.Fields("ESTADO")
Me.Text_cep = rs.Fields("CEP")
Me.Text_telefone = rs.Fields("TELEFONE")
Me.Text_cpf = rs.Fields("CPF")
Me.Text_habilitacao = rs.Fields("HABILITACAO")
Tela 004
O Mesmo procedimento com o botão editar usando o codigo abaixo:
Dim CADASTRO(1 To 10)
CADASTRO(1) = UCase(Me.Text_Codigo)
CADASTRO(2) = UCase(Me.Text_Nome)
CADASTRO(3) = LCase(Me.Text_endereco)
CADASTRO(4) = UCase(Me.Text_cidade)
CADASTRO(5) = UCase(Me.Text_bairro)
CADASTRO(6) = UCase(Me.Text_estado)
CADASTRO(7) = UCase(Me.Text_cep)
CADASTRO(8) = UCase(Me.Text_telefone)
CADASTRO(9) = UCase(Me.Text_cpf)
CADASTRO(10) = UCase(Me.Text_habilitacao)
CADASTRO(10) = UCase(Me.Text_Codigo.Value)
For I = 1 To 10
Plan1.Cells(Val(Me.Text_Codigo) + 1, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "ALTERAÇÃO EFETUADA", vbInformation, "CADASTRO DE ENDEREÇOS"
ThisWorkbook.Save
Tela 005
O mesmo procedimento para o botão apagar:
Dim MOTORISTA
MOTORISTA = MsgBox("DESEJA REALMENTE EXCLUIR O REGISTRO", vbYesNo + vbQuestion, "CADASTRO DE ENDEREÇOS")
If MOTORISTA = vbYes Then
Plan1.Cells(Val(Me.Text_Codigo) + 1, 1).EntireRow.Delete
ThisWorkbook.Save
End If
E depois para o botão voltar:
Me.hide
Tela 006 (Botão Apagar)
Tela 007
Feito esta parte, para as demais interface irei colcar apenas os codigos e você deve fazer os mesmos procedimentos:
Codigos para a Interface Peças:
Dentro do formulário:
Label8 = Application.WorksheetFunction.CountA(Plan2.Columns(1)) – 1
Dentro do Botão Cadastrar:
Dim bd As Database
Dim rs As Recordset
Set bd = OpenDatabase("C:\Documents and Settings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "excel 8.0")
Set rs = bd.OpenRecordset("Plan2$", dbOpenDynaset)
If Me.Text_Codigo > Me.Label8 Then
If Me.Text_Codigo = "" Then
Me.Text_Codigo.Text = "-"
End If
If Me.Text_descricao.Text = "" Then
Me.Text_descricao.Text = "-"
End If
If Me.Text_fabricante.Text = "" Then
Me.Text_fabricante.Text = "-"
End If
If Me.Text_modelo = "" Then
Me.Text_modelo.Text = "-"
End If
If Me.Text_valor = "" Then
Me.Text_valor.Text = "-"
End If
Dim CADASTRO(1 To 6)
CADASTRO(1) = UCase(Me.Text_Codigo)
CADASTRO(2) = UCase(Me.Text_descricao)
CADASTRO(3) = LCase(Me.Text_fabricante)
CADASTRO(4) = UCase(Me.Text_modelo)
CADASTRO(5) = UCase(Me.Text_valor)
CADASTRO(6) = UCase(Me.Text_Codigo.Value)
Dim MOTORISTA As Object
Dim L, I
Set MOTORISTA = Plan2.Cells(1, 1).CurrentRegion
L = MOTORISTA.Rows.Count + 1
If Len(Me.Text_Codigo) = 0 Then
MsgBox "VOCÊ NÃO DIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DE ENDEREÇOS"
Else
For I = 1 To 6
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 REGISTRO digite um número maior do que há no campo QTD para casdastrar."
End If
Dentro do Botão Pesquisar:
Dim DB As Database
Dim rs As Recordset
Set DB = OpenDatabase("C:\Documents and Settings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "Excel 8.0")
Set rs = DB.OpenRecordset("PLAN2$", dbOpenDynaset)
rs.FindFirst "PECA LIKE'" & Me.Text_descricao & "'"
If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub
Me.Text_Codigo = rs.Fields("CODIGO")
Me.Text_descricao = rs.Fields("PECA")
Me.Text_fabricante = rs.Fields("FABRICANTE")
Me.Text_modelo = rs.Fields("VALOR")
Me.Text_valor = rs.Fields("VALOR")
Dentro do botão editar:
Dim CADASTRO(1 To 5)
CADASTRO(1) = UCase(Me.Text_Codigo)
CADASTRO(2) = UCase(Me.Text_descricao)
CADASTRO(3) = LCase(Me.Text_fabricante)
CADASTRO(4) = UCase(Me.Text_modelo)
CADASTRO(5) = UCase(Me.Text_valor)
CADASTRO(5) = UCase(Me.Text_Codigo.Value)
For I = 1 To 5
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
Dentro do Botão apagar:
Dim MOTORISTA
MOTORISTA = MsgBox("DESEJA REALMENTE EXCLUIR O REGISTRO", vbYesNo + vbQuestion, "CADASTRO DE ENDEREÇOS")
If MOTORISTA = vbYes Then
Plan2.Cells(Val(Me.Text_Codigo) + 1, 1).EntireRow.Delete
ThisWorkbook.Save
End If
Dentro do botão Voltar:
Me.hide
Interface Principal:
Dentro do botão motorista:
MOTORISTA.Show
Dentro do botão peças:
PECAS.Show
Dentro do botão veiculos:
VEICULOS.Show
Dentro do botão troca:
TROCA.Show
Dentro do botão fechar:
PRINCIPAL.Hide
Interface Troca:
Dentro do formulário:
Label8 = Application.WorksheetFunction.CountA(Plan3.Columns(1)) – 1
Dentro do botão cadastrar:
Dim bd As Database
Dim rs As Recordset
Set bd = OpenDatabase("C:\Documents and Settings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "excel 8.0")
Set rs = bd.OpenRecordset("Plan3$", dbOpenDynaset)
If Me.codigo > Me.Label8 Then
If Me.codigo = "" Then
Me.codigo.Text = "-"
End If
If Me.peca.Text = "" Then
Me.peca.Text = "-"
End If
If Me.nome_peca.Text = "" Then
Me.nome_peca.Text = "-"
End If
If Me.Placa_veiculo = "" Then
Me.Placa_veiculo.Text = "-"
End If
If Me.data = "" Then
Me.data.Text = "-"
End If
Dim CADASTRO(1 To 6)
CADASTRO(1) = UCase(Me.codigo)
CADASTRO(2) = UCase(Me.peca)
CADASTRO(3) = LCase(Me.nome_peca)
CADASTRO(4) = UCase(Me.Placa_veiculo)
CADASTRO(5) = UCase(Me.data)
CADASTRO(6) = UCase(Me.codigo.Value)
Dim MOTORISTA As Object
Dim L, I
Set MOTORISTA = Plan3.Cells(1, 1).CurrentRegion
L = MOTORISTA.Rows.Count + 1
If Len(Me.codigo) = 0 Then
MsgBox "VOCÊ NÃO DIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DE ENDEREÇOS"
Else
For I = 1 To 6
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 REGISTRO digite um número maior do que há no campo QTD para casdastrar."
End If
Dentro do botão editar:
Dim CADASTRO(1 To 5)
CADASTRO(1) = UCase(Me.codigo)
CADASTRO(2) = UCase(Me.peca)
CADASTRO(3) = LCase(Me.nome_peca)
CADASTRO(4) = UCase(Me.Placa_veiculo)
CADASTRO(5) = UCase(Me.data)
CADASTRO(5) = UCase(Me.codigo.Value)
For I = 1 To 5
Plan3.Cells(Val(Me.codigo) + 1, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "ALTERAÇÃO EFETUADA", vbInformation, "CADASTRO DE ENDEREÇOS"
ThisWorkbook.Save
Dentro do Botão Pesquisar:
Dim DB As Database
Dim rs As Recordset
Set DB = OpenDatabase("C:\Documents and Settings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "Excel 8.0")
Set rs = DB.OpenRecordset("PLAN3$", dbOpenDynaset)
rs.FindFirst "NPECA LIKE'" & Me.nome_peca & "'"
If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub
Me.codigo = rs.Fields("CODIGO")
Me.peca = rs.Fields("CPECA")
Me.nome_peca = rs.Fields("NPECA")
Me.Placa_veiculo = rs.Fields("VEICULO")
Me.data = rs.Fields("DATA")
Dentro do botão apagar:
Dim MOTORISTA
MOTORISTA = MsgBox("DESEJA REALMENTE EXCLUIR O REGISTRO", vbYesNo + vbQuestion, "CADASTRO DE ENDEREÇOS")
If MOTORISTA = vbYes Then
Plan3.Cells(Val(Me.codigo) + 1, 1).EntireRow.Delete
ThisWorkbook.Save
End If
Dentro do botão voltar:
Me.hide
E por último a interface Veiculos:
Dentro do fomulário:
Label15 = Application.WorksheetFunction.CountA(Plan4.Columns(1)) – 1
Dentro do botão cadastrar:
Dim bd As Database
Dim rs As Recordset
Set bd = OpenDatabase("C:\Documents and Settings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "excel 8.0")
Set rs = bd.OpenRecordset("Plan4$", dbOpenDynaset)
If Me.Text_Codigo > Me.Label15 Then
If Me.Text_Codigo = "" Then
Me.Text_Codigo.Text = "-"
End If
If Me.Text_placa.Text = "" Then
Me.Text_placa.Text = "-"
End If
If Me.Text_fabricante.Text = "" Then
Me.Text_fabricante.Text = "-"
End If
If Me.Text_combustivel = "" Then
Me.Text_combustivel.Text = "-"
End If
If Me.Text_peso = "" Then
Me.Text_peso.Text = "-"
End If
If Me.Text_chassis = "" Then
Me.Text_chassis.Text = "-"
End If
If Me.Text_ano = "" Then
Me.Text_ano = "-"
End If
If Me.Text_modelo = "" Then
Me.Text_modelo.Text = "-"
End If
If Me.Text_autonomia = "" Then
Me.Text_autonomia.Text = "-"
End If
If Me.Text_altura = "" Then
Me.Text_altura.Text = "-"
End If
If Me.Text_observacoes = "" Then
Me.Text_observacoes.Text = "-"
End If
If Me.Text_marca = "" Then
Me.Text_marca.Text = "-"
End If
Dim CADASTRO(1 To 13)
CADASTRO(1) = UCase(Me.Text_Codigo)
CADASTRO(2) = UCase(Me.Text_placa)
CADASTRO(3) = LCase(Me.Text_marca)
CADASTRO(4) = UCase(Me.Text_fabricante)
CADASTRO(5) = UCase(Me.Text_combustivel)
CADASTRO(6) = UCase(Me.Text_peso)
CADASTRO(7) = UCase(Me.Text_chassis)
CADASTRO(8) = UCase(Me.Text_ano)
CADASTRO(9) = UCase(Me.Text_modelo)
CADASTRO(10) = UCase(Me.Text_autonomia)
CADASTRO(11) = UCase(Me.Text_altura)
CADASTRO(12) = UCase(Me.Text_observacoes)
CADASTRO(13) = UCase(Me.Text_Codigo.Value)
Dim MOTORISTA As Object
Dim L, I
Set MOTORISTA = Plan4.Cells(1, 1).CurrentRegion
L = MOTORISTA.Rows.Count + 1
If Len(Me.Text_Codigo) = 0 Then
MsgBox "VOCÊ NÃO DIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DE ENDEREÇOS"
Else
For I = 1 To 13
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 REGISTRO digite um número maior do que há no campo QTD para cadastrar."
End If
Dentro do botão pesquisar:
Dim DB As Database
Dim rs As Recordset
Set DB = OpenDatabase("C:\Documents and Settings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "Excel 8.0")
Set rs = DB.OpenRecordset("PLAN4$", dbOpenDynaset)
rs.FindFirst "PLACA LIKE'" & Me.Text_placa & "'"
If rs.NoMatch = True Then MsgBox "Nome não cadastrado", vbInformation, "Banco de dados": Exit Sub
Me.Text_Codigo = rs.Fields("CODIGO")
Me.Text_placa = rs.Fields("PLACA")
Me.Text_marca = rs.Fields("MARCA")
Me.Text_fabricante = rs.Fields("FABRICANTE")
Me.Text_combustivel = rs.Fields("COMBUSTIVEL")
Me.Text_peso = rs.Fields("PESO")
Me.Text_chassis = rs.Fields("CHASSIS")
Me.Text_ano = rs.Fields("ANO")
Me.Text_modelo = rs.Fields("MODELO")
Me.Text_autonomia = rs.Fields("AUTONOMIA")
Me.Text_altura = rs.Fields("ALTURA")
Me.Text_observacoes = rs.Fields("OBS")
Dentro do botão editar:
Dim CADASTRO(1 To 13)
CADASTRO(1) = UCase(Me.Text_Codigo)
CADASTRO(2) = UCase(Me.Text_placa)
CADASTRO(3) = LCase(Me.Text_marca)
CADASTRO(4) = UCase(Me.Text_fabricante)
CADASTRO(5) = UCase(Me.Text_combustivel)
CADASTRO(6) = UCase(Me.Text_peso)
CADASTRO(7) = UCase(Me.Text_chassis)
CADASTRO(8) = UCase(Me.Text_ano)
CADASTRO(9) = UCase(Me.Text_modelo)
CADASTRO(10) = UCase(Me.Text_autonomia)
CADASTRO(11) = UCase(Me.Text_altura)
CADASTRO(12) = UCase(Me.Text_observacoes)
CADASTRO(13) = UCase(Me.Text_Codigo.Value)
For I = 1 To 13
Plan4.Cells(Val(Me.Text_Codigo) + 1, I).Value = Trim(CADASTRO(I))
Next I
MsgBox "ALTERAÇÃO EFETUADA", vbInformation, "CADASTRO DE ENDEREÇOS"
ThisWorkbook.Save
Dentro do botão apagar:
Dim MOTORISTA
MOTORISTA = MsgBox("DESEJA REALMENTE EXCLUIR O REGISTRO", vbYesNo + vbQuestion, "CADASTRO DE ENDEREÇOS")
If MOTORISTA = vbYes Then
Plan4.Cells(Val(Me.Text_Codigo) + 1, 1).EntireRow.Delete
ThisWorkbook.Save
End If
Dentro do botão voltar:
Me.hide
Neste tutorial ensinei a codificar o sistema, sendo que a interface gráfica motorista, mostrei passo a passo, expliquei qual a função do código, em que propriedade o formulário deveria ser colocada, mostrado através de telas. As demais interfaces coloquei o codigo e onde o mesmo deveria ser inserido, sendo que os procedimentos são os mesmos descritos na interface motoristas. Espero que este sistema possa ajuda-lo de alguma forma para seu aprendizado,até o próximo sistema e bons estudos!.
Confira todas as partes deste tutorial:
CURSO PROFISSIONALIZANTE DE INFORMÁTICA |
São 68 Cursos -
3440 Vídeo Aulas - 396:07 horas |
Domine Todos os Recursos de Informática Exigidos pelo Mercado de Trabalho, Através de Exemplos Práticos, Completos e Úteis, Detalhadamente Explicados - Passo a Passo |
Para Todos os Detalhes, Acesse:
https://juliobattisti.com.br/informatica-curso-completo-1v.asp |
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