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:
O objetivo deste tutorial e deconcluir o sistema para controle de frota de veículos, irei ensinar a codificartodas as interfaces grafica do mesmo.
Pré-requisito:
Para você poder acompanhar odesenvolvimento deste tutorial, será necessário ter conhecimento no mínimo do “CursoBásico de Excel e os Tutoriais Utilizando Editor do Visual Basic do Excel Parte1 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 daprimeira interface do sistemas, as demais irei colocar o codigo para você copiar, sendo é só seguir os mesmosprocedimentos para a codificação.
O primeiro procedimento que iremos fazer será ativar abiblioteca Microsoft Dao para que os códigos funcione, para isso, abra oprojeto clique sobre a interface motorista, esta é a que irei ensinar passo apasso a codificar.
Quandoa mesma estiver ativada clique no menu ferramentas logo em seguida emreferências na janela que ira abrir você deve, então, ativar a biblioteca, vejana tela abaixo:
Tela 001
Agora iremos começar a inserir os codigos na interfacegrafica, este primeiro codigo, será para mostar a quantidade de registrosarmazenados no banco de dados, iremos inserir o mesmo dentro da propriedadeinitialize do formulário, clique duas vezes sobre o mesmo para ativar a janelade codigo, sendo que esta propriedade vai fazer com que o código seja ativadoasim 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 ajanela de codigo, depois copie e cole o codigo abaixo, sendo qe utilizaremos apropriedade 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\Meusdocumentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "excel8.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 AsObject
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ÃODIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DEENDEREÇOS"
Else
For I = 1 To11
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 doque há no campo QTD para casdastrar."
EndIf
Tela 003
Agora faça o mesmo procedimento para o botão Pesquisarcom o codigo abaixo:
Dim DB As Database
Dim rs As Recordset
Set DB =OpenDatabase("C:\Documents and Settings\infohelp\Meusdocumentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "Excel8.0")
Set rs = DB.OpenRecordset("PLAN1$",dbOpenDynaset)
rs.FindFirst "NOMELIKE'" & 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 ocodigo 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 DEENDEREÇ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 colcarapenas os codigos e você deve fazer os mesmos procedimentos:
Codigospara 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\Meusdocumentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "excel8.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 AsObject
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ÃODIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DEENDEREÇ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 doque 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\Meusdocumentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "Excel8.0")
Set rs = DB.OpenRecordset("PLAN2$",dbOpenDynaset)
rs.FindFirst "PECALIKE'" & 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")
Dentrodo 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 DEENDEREÇOS"
ThisWorkbook.Save
Dentrodo 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
Dentrodo botão Voltar:
Me.hide
InterfacePrincipal:
Dentrodo botão motorista:
MOTORISTA.Show
Dentrodo botão peças:
PECAS.Show
Dentrodo botão veiculos:
VEICULOS.Show
Dentrodo botão troca:
TROCA.Show
Dentrodo botão fechar:
PRINCIPAL.Hide
InterfaceTroca:
Dentrodo formulário:
Label8 =Application.WorksheetFunction.CountA(Plan3.Columns(1)) – 1
Dentrodo botão cadastrar:
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:
Dim bd As Database
Dim rs As Recordset
Set bd = OpenDatabase("C:\Documents andSettings\infohelp\Meus documentos\APLICATIVO\SISTEMA FROTA\FROTA.xls",False, False, "excel 8.0")
Set rs =bd.OpenRecordset("Plan3$", dbOpenDynaset)
If Me.codigo > Me.Label8Then
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 AsObject
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 doque há no campo QTD para casdastrar."
End If
Dentrodo 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ÇÃOEFETUADA", vbInformation, "CADASTRO DE ENDEREÇOS"
ThisWorkbook.Save
Dentrodo Botão Pesquisar:
Dim DB As Database
Dim rs As Recordset
Set DB =OpenDatabase("C:\Documents and Settings\infohelp\Meusdocumentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "Excel8.0")
Set rs = DB.OpenRecordset("PLAN3$",dbOpenDynaset)
rs.FindFirst "NPECALIKE'" & 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")
Dentrodo 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:
Dentrodo fomulário:
Label15 =Application.WorksheetFunction.CountA(Plan4.Columns(1)) – 1
Dentrodo botão cadastrar:
Dim bd As Database
Dim rs As Recordset
Set bd = OpenDatabase("C:\Documents andSettings\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 AsObject
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ÃODIGITOU NENHUM NOME PARA INCLUSÃO", vbCritical, "CADASTRO DEENDEREÇOS"
Else
For I = 1 To13
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 doque há no campo QTD para cadastrar."
End If
Dentrodo botão pesquisar:
Dim DB As Database
Dim rs As Recordset
Set DB =OpenDatabase("C:\Documents and Settings\infohelp\Meusdocumentos\APLICATIVO\SISTEMA FROTA\FROTA.xls", False, False, "Excel8.0")
Set rs = DB.OpenRecordset("PLAN4$",dbOpenDynaset)
rs.FindFirst "PLACALIKE'" & 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")
Dentrodo 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 DEENDEREÇOS"
ThisWorkbook.Save
Dentrodo 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
Dentrodo botão voltar:
Me.hide
Neste tutorial ensinei a codificar o sistema, sendoque a interface gráfica motorista, mostrei passo a passo, expliquei qual afunçã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 omesmo deveria ser inserido, sendo que os procedimentos são os mesmos descritosna interface motoristas. Espero que este sistema possa ajuda-lo de alguma formapara seu aprendizado,até o próximo sistema e 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-2025 ®
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