Cadastro de clientes VBA Excel com Imagem e Pesquisa

Controle de ponto - Folha ponto Excel
Controle de ponto – Folha ponto Excel
19 de setembro de 2013
Dashboard de Vendas - Painel de Vendas Excel
Dashboard de Vendas – Painel de Vendas Excel
3 de outubro de 2013

Objetivo: Disponibilizar um exemplo de cadastro de clientes Excel VBA com imagem e pesquisa.


*************************************************ATENÇÃO*************************************************

Entre os dias 07 e 17 de fevereiro de 2019 estará ocorrendo um evento incrível de uma das referências em Dashboards no Brasil, Karen Abecia.

Fiz um artigo para você conhecer um pouco do que será mostrado neste evento Online e Gratuito e veja suas planilhas se transformarem.

Clique no dash abaixo para ver dashs incríveis:

Aprenda a fazer dashboards incríveis - Evento Gratuito online

Link do artigo: MasterClass Online e Gratuito sobre Dashboards no Excel


 

FormularioVBAPesquisa

Este exemplo de planilha complementa o artigo http://guiadoexcel.com.br/cadastro-vba-com-imagem incluindo no mesmo a pesquisa dos dados cadastrados buscando pelo nome.

Em um novo artigo vou alterar este projeto para que possam ser realizadas buscas por outros campos também.

Abaixo o código fonte do formulário de cadastro e de pesquisa utilizando um cadastro VBA Excel e o ListBox, pesquisando ainda e selecionando o item na planilha.

FormularioVBAExcel

Private Sub cmdAlterar_Click()
    lsHabilitar
End Sub

Private Sub cmdAnterior_Click()
    Dim currentFind As Range

    If IsNumeric(lblCod.Caption) = True Then
        Set currentFind = Worksheets("Clientes").Range("A:A").Find(lblCod.Caption, , _
            Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
            Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)

        If currentFind.Row >= 2 And IsNumeric(Worksheets("Clientes").Cells(currentFind.Row - 1, 1)) Then
            lsLocalizaRegistroStudent (CLng(Worksheets("Clientes").Cells(currentFind.Row - 1, 1)))
            Me.Image1.Picture = LoadPicture(Worksheets("Clientes").Cells.Range("M" & currentFind.Row - 1).Value)
            Image1.PictureSizeMode = fmPictureSizeModeStretch
        End If
        Sheets("Menu").Activate
    End If
End Sub

Private Sub cmdExcluir_Click()
    Dim lLinha As Long
    Dim currentFind As Range
    Dim lPosicao As String
    
    iTotalLinhas = Sheets("Clientes").Cells(Rows.Count, 1).End(xlUp).Row

    If IsNumeric(lblCod.Caption) = True Then
        Set currentFind = Worksheets("Clientes").Range("A:A").Find(lblCod.Caption, , _
            Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
            Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)

        lLinha = currentFind.Row
        
        currentFind.EntireRow.Delete
            
        If lLinha  2 Then
            lsLocalizaRegistroStudent (CLng(Worksheets("Clientes").Cells(lLinha + 1, 1)))
        Else
            lsLimparStudents
        End If
        
        Sheets("Menu").Activate
    End If

    Sheets("Menu").Activate
End Sub

Private Sub cmdIncluir_Click()
    lsHabilitar
    lsLimparStudents

    txtName.SetFocus
End Sub

Private Sub cmdProximo_Click()
    Dim lLinha As Long
    Dim currentFind As Range
    
    iTotalLinhas = Sheets("Clientes").Cells(Rows.Count, 1).End(xlUp).Row

    If IsNumeric(lblCod.Caption) = True Then
        Set currentFind = Worksheets("Clientes").Range("A:A").Find(lblCod.Caption, , _
            Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
            Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
            
        If currentFind.Row < iTotalLinhas And IsNumeric(Worksheets("Clientes").Cells(currentFind.Row + 1, 1)) Then
            lsLocalizaRegistroStudent (CLng(Worksheets("Clientes").Cells(currentFind.Row + 1, 1)))
            Me.Image1.Picture = LoadPicture(Worksheets("Clientes").Cells.Range("M" & currentFind.Row + 1).Value)
            Image1.PictureSizeMode = fmPictureSizeModeStretch
        End If
        
        Sheets("Menu").Activate
    End If
End Sub

Private Sub cmdSair_Click()
    Unload Me
End Sub

Private Sub cmdPrimeiro_Click()
    lsLocalizaRegistroStudent (Worksheets("Clientes").Cells(2, 1).Value)
    Me.Image1.Picture = LoadPicture(Worksheets("Clientes").Cells.Range("M2").Value)
    Image1.PictureSizeMode = fmPictureSizeModeStretch
    Sheets("Menu").Activate
End Sub

Private Sub cmdSalvar_Click()
    
    If txtName.Enabled = True And lfValidarDados = True Then
        If Not IsNumeric(lblCod.Caption) = True Then
            lsInserirStudent
            Sheets("Menu").Activate
        Else
            lsAlterarStudent
            Sheets("Menu").Activate
        End If
        
        lsDesabilitar
        MsgBox "Registro Salvo!"
    End If
End Sub

Private Sub cmdUltimo_Click()
    Dim iTotalLinhas As Long
    
    iTotalLinhas = 999999
    
    lsLocalizaRegistroStudent (iTotalLinhas)
    Me.Image1.Picture = LoadPicture(Worksheets("Clientes").Cells.Range("M" & LinhaAtual + 2).Value)
    Image1.PictureSizeMode = fmPictureSizeModeStretch
    
    'Me.Image1.Picture = LoadPicture(Worksheets("Clientes").Cells.Range("M" & currentFind.Row + 1).Value)
    'Image1.PictureSizeMode = fmPictureSizeModeStretch LinhaAtual
    
    
    Sheets("Menu").Activate
End Sub

Private Sub CommandButton1_Click()
    frmPesquisaClientes.Show
End Sub

Private Sub Image1_Click()
    Dim myPictName  As String
    Dim lLinha      As Long
    
    myPictName = Application.GetOpenFilename(filefilter:="Picture Files,*.ico;*.bmp")
    
    If IsNumeric(lblCod.Caption) = True Then
        Set currentFind = Worksheets("Clientes").Range("A:A").Find(lblCod.Caption, , _
            Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
            Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)

        lLinha = currentFind.Row
    Else
        lLinha = Sheets("Clientes").Cells(Rows.Count, 1).End(xlUp).Row + 1
    End If
    
    If myPictName  "" Then
        Me.Image1.Picture = LoadPicture(myPictName)
        Image1.PictureSizeMode = fmPictureSizeModeStretch
        Image1.Visible = False
        Image1.Visible = True
        Worksheets("Clientes").Cells.Range("M" & lLinha).Value = myPictName
    End If
End Sub

Private Sub UserForm_Activate()
           
    lsLocalizaRegistroStudent (Worksheets("Clientes").Cells(2, 1).Value)
    LinhaAtual = 2
    Sheets("Menu").Activate
End Sub


'Procedimento para selecionar arquivos
Function lfSelecionarArquivo() As String
    Dim fDlg As FileDialog
    Dim lArquivo As String

    'Chama o objeto passando os parâmetros
    Set fDlg = Application.FileDialog(FileDialogType:=msoFileDialogOpen)
    With fDlg
        'Alterar esta propriedade para True permitirá a seleção de vários arquivos
        .AllowMultiSelect = False

        'Determina a forma de visualização dos aruqivos
        .InitialView = msoFileDialogViewDetails

        'Filtro de arquivos, pode ser colocado mais do que um filtro separando com ; por exemplo: "*.xls;*.xlsm"
        .Filters.Add "Imagem", "*.bmp, *.ico", 1

        'Determina qual o drive inicial
        .InitialFileName = "C:\"
    End With

    'Retorna o arquivo selecionado
    If fDlg.Show = -1 Then
        lfSelecionarArquivo = fDlg.SelectedItems(1)
    Else
        MsgBox "Não foi selecionado nenhum arquivo"
    End If
End Function


Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Sheets("Clientes").Range("A" & Sheets("Pesquisa").Range("O" & ListBox1.ListIndex + 2)).Select
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   If KeyCode = 13 Then
        ListBox1.RowSource = ""
        pesquisa
    End If
End Sub

Sub pesquisa()
    Dim n As Long
    n = 1
    
    Sheets("Pesquisa").Range("A2:O1000000").Clear
    Sheets("Clientes").Select
    Sheets("Clientes").Range("B1").Select
    
    Do While ActiveCell  ""
        If InStr(1, UCase(ActiveCell), UCase(TextBox1)) > 0 Then
            Sheets("Pesquisa").Range("B" & n).Offset(1, -1).Value = ActiveCell.Offset(0, -1)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 0).Value = ActiveCell.Offset(0, 0)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 1).Value = ActiveCell.Offset(0, 1)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 2).Value = ActiveCell.Offset(0, 2)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 3).Value = ActiveCell.Offset(0, 3)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 4).Value = ActiveCell.Offset(0, 4)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 5).Value = ActiveCell.Offset(0, 5)
            Sheets("Clientes").Range("B" & n).Offset(1, 6).Value = ActiveCell.Offset(0, 6)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 7).Value = ActiveCell.Offset(0, 7)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 8).Value = ActiveCell.Offset(0, 8)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 9).Value = ActiveCell.Offset(0, 9)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 10).Value = ActiveCell.Offset(0, 10)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 11).Value = ActiveCell.Offset(0, 11)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 12).Value = ActiveCell.Offset(0, 12)
            Sheets("Pesquisa").Range("B" & n).Offset(1, 13).Value = ActiveCell.Row
            n = n + 1
        End If
           ActiveCell.Offset(1, 0).Select
    Loop
    If n > 1 Then
        ListBox1.RowSource = "Pesquisa!A2:M" & n
    Else
        ListBox1.RowSource = ""
        MsgBox "Nenhum registro encontrado", vbInformation, "Aviso"
    End If
End Sub

Private Sub UserForm_Activate()
    TextBox1.SetFocus
End Sub

Private Sub UserForm_Click()

End Sub
Public LinhaAtual As Long

Sub lsShowStudents()
    frmCadastroStudents.Show
End Sub

Sub lsInserirStudent()

    Dim iTotalLinhas As Integer
    Dim lUltima As Long
    
    iTotalLinhas = Sheets("Clientes").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
    If IsNumeric(Sheets("Clientes").Cells(iTotalLinhas - 1, 1).Value) Then
        lUltima = Sheets("Clientes").Cells(iTotalLinhas - 1, 1).Value + 1
    Else
        lUltima = 1
    End If
    
    With frmCadastroStudents
        .lblCod = lUltima
        Sheets("Clientes").Cells(iTotalLinhas, 1).Value = lUltima
        Sheets("Clientes").Cells(iTotalLinhas, 2).Value = .txtName
        Sheets("Clientes").Cells(iTotalLinhas, 3).Value = .txtAddress
        Sheets("Clientes").Cells(iTotalLinhas, 4).Value = .txtNumber
        Sheets("Clientes").Cells(iTotalLinhas, 5).Value = .txtNeighb
        Sheets("Clientes").Cells(iTotalLinhas, 6).Value = .txtCity
        Sheets("Clientes").Cells(iTotalLinhas, 7).Value = .txtUF
        Sheets("Clientes").Cells(iTotalLinhas, 8).Value = .txtDDD1
        Sheets("Clientes").Cells(iTotalLinhas, 9).Value = .txtPhone1
        Sheets("Clientes").Cells(iTotalLinhas, 10).Value = .txtDDD2
        Sheets("Clientes").Cells(iTotalLinhas, 11).Value = .txtPhone2
        Sheets("Clientes").Cells(iTotalLinhas, 12).Value = .txtEmail
    End With
End Sub

Sub lsLocalizaRegistroStudent(ByVal lRegistro As Long)

    Dim lLinha As Long
    
    'Sheets("Clientes").Activate
    iTotalLinhas = Sheets("Clientes").Cells(Rows.Count, 1).End(xlUp).Row

    'Define a Range de Pesquisa
    Set currentFind = Worksheets("Clientes").Range("A:A").Find(lRegistro, , _
        Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
        Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)

    If lRegistro = 999999 Then
        lLinha = iTotalLinhas
        
        Set currentFind = Worksheets("Clientes").Range("A:A").Find(lLinha - 1, , _
            Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
            Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
    Else
        If Not currentFind Is Nothing Then
            lLinha = currentFind.Row
        End If
    End If

    If Not currentFind Is Nothing Then
        With frmCadastroStudents
            .lblCod = Sheets("Clientes").Cells(lLinha, 1).Value
            .txtName = Sheets("Clientes").Cells(lLinha, 2).Value
            .txtAddress = Sheets("Clientes").Cells(lLinha, 3).Value
            .txtNumber = Sheets("Clientes").Cells(lLinha, 4).Value
            .txtNeighb = Sheets("Clientes").Cells(lLinha, 5).Value
            .txtCity = Sheets("Clientes").Cells(lLinha, 6).Value
            .txtUF = Sheets("Clientes").Cells(lLinha, 7).Value
            .txtDDD1 = Sheets("Clientes").Cells(lLinha, 8).Value
            .txtPhone1 = Sheets("Clientes").Cells(lLinha, 9).Value
            .txtDDD2 = Sheets("Clientes").Cells(lLinha, 10).Value
            .txtPhone2 = Sheets("Clientes").Cells(lLinha, 11).Value
            .txtEmail = Sheets("Clientes").Cells(lLinha, 12).Value
            frmCadastroStudents.Image1.Picture = LoadPicture(Worksheets("Clientes").Cells.Range("M" & lLinha).Value)
            frmCadastroStudents.Image1.PictureSizeMode = fmPictureSizeModeStretch
        End With
    End If
End Sub

Sub lsAlterarStudent()
    
    'Define a Range de Pesquisa
    Set currentFind = Worksheets("Clientes").Range("A:A").Find(frmCadastroStudents.lblCod, , _
        Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
        Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
        
    lLinha = currentFind.Row
    
    With frmCadastroStudents
        Sheets("Clientes").Cells(lLinha, 2).Value = .txtName
        Sheets("Clientes").Cells(lLinha, 3).Value = .txtAddress
        Sheets("Clientes").Cells(lLinha, 4).Value = .txtNumber
        Sheets("Clientes").Cells(lLinha, 5).Value = .txtNeighb
        Sheets("Clientes").Cells(lLinha, 6).Value = .txtCity
        Sheets("Clientes").Cells(lLinha, 7).Value = .txtUF
        Sheets("Clientes").Cells(lLinha, 8).Value = .txtDDD1
        Sheets("Clientes").Cells(lLinha, 9).Value = .txtPhone1
        Sheets("Clientes").Cells(lLinha, 10).Value = .txtDDD2
        Sheets("Clientes").Cells(lLinha, 11).Value = .txtPhone2
        Sheets("Clientes").Cells(lLinha, 12).Value = .txtEmail
        LinhaAtual = lLinha
    End With
End Sub

Sub lsHabilitar()
    With frmCadastroStudents
        .txtName.Enabled = True
        .txtAddress.Enabled = True
        .txtNumber.Enabled = True
        .txtNeighb.Enabled = True
        .txtCity.Enabled = True
        .txtUF.Enabled = True
        .txtDDD1.Enabled = True
        .txtPhone1.Enabled = True
        .txtDDD2.Enabled = True
        .txtPhone2.Enabled = True
        .txtEmail.Enabled = True
        .Image1.Enabled = True
    End With
End Sub

Sub lsDesabilitar()
    With frmCadastroStudents
        .txtName.Enabled = False
        .txtAddress.Enabled = False
        .txtNumber.Enabled = False
        .txtNeighb.Enabled = False
        .txtCity.Enabled = False
        .txtUF.Enabled = False
        .txtDDD1.Enabled = False
        .txtPhone1.Enabled = False
        .txtDDD2.Enabled = False
        .txtPhone2.Enabled = False
        .txtEmail.Enabled = False
        .Image1.Enabled = False
    End With
End Sub

Sub lsLimparStudents()
    With frmCadastroStudents
        .lblCod.Caption = ""
        .txtName.Text = ""
        .txtAddress.Text = ""
        .txtNumber.Text = ""
        .txtNeighb.Text = ""
        .txtCity.Text = ""
        .txtUF.Text = ""
        .txtDDD1.Text = ""
        .txtPhone1.Text = ""
        .txtDDD2.Text = ""
        .txtPhone2.Text = ""
        .txtEmail.Text = ""
        .Image1.Picture = LoadPicture("")
    End With
End Sub

Function lfValidarDados() As Boolean

    lfValidarDados = False
    
    With Worksheets("Validacao")
        If frmCadastroStudents.txtName.Text = "" And .Cells(3, 2).Value = "Sim" Then
            MsgBox "O campo Nome é obrigatório!"
            frmCadastroStudents.txtName.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtAddress.Text = "" And .Cells(4, 2).Value = "Sim" Then
            MsgBox "O campo Logradouro é obrigatório!"
            frmCadastroStudents.txtAddress.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtNumber.Text = "" And .Cells(5, 2).Value = "Sim" Then
            MsgBox "O campo Número é obrigatório!"
            frmCadastroStudents.txtNumber.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtNeighb.Text = "" And .Cells(6, 2).Value = "Sim" Then
            MsgBox "O campo Bairro é obrigatório!"
            frmCadastroStudents.txtNeighb.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtCity.Text = "" And .Cells(7, 2).Value = "Sim" Then
            MsgBox "O campo Cidade é obrigatório!"
            frmCadastroStudents.txtCity.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtUF.Text = "" And .Cells(8, 2).Value = "Sim" Then
            MsgBox "O campo UF é obrigatório!"
            frmCadastroStudents.txtUF.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtDDD1.Text = "" And .Cells(9, 2).Value = "Sim" Then
            MsgBox "O campo DDD1 é obrigatório!"
            frmCadastroStudents.txtDDD1.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtPhone1.Text = "" And .Cells(10, 2).Value = "Sim" Then
            MsgBox "O campo Fone1 é obrigatório!"
            frmCadastroStudents.txtPhone1.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtDDD2.Text = "" And .Cells(11, 2).Value = "Sim" Then
            MsgBox "O campo DDD2 é obrigatório!"
            frmCadastroStudents.txtDDD2.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtPhone2.Text = "" And .Cells(12, 2).Value = "Sim" Then
            MsgBox "O campo Fone2 é obrigatório!"
            frmCadastroStudents.txtPhone2.SetFocus
            GoTo Sair
        End If
        If frmCadastroStudents.txtEmail.Text = "" And .Cells(13, 2).Value = "Sim" Then
            MsgBox "O campo e-mail é obrigatório!"
            frmCadastroStudents.txtEmail.SetFocus
            GoTo Sair
        End If
    End With
    
    lfValidarDados = True
        
Sair:
    Exit Function
End Function

Abraço

Marcos Rieper


Clique aqui e leia mais sobre Excel VBA. https://www.guiadoexcel.com.br/vba/ O Guia do Excel foi criado por Marcos Rieper e oferece artigos, dicas, tutoriais e modelos de planilhas prontas. Aqui você encontra tudo sobre Excel, seja de nível básico, intermediário,  avançado e VBA. O Guia do Excel oferece diversos materiais completamente gratuitos para download. Navegue em nosso site e confira! Conheça também a nossa Loja do Excel https://loja.guiadoexcel.com.br/
Cursos

Curso Excel Completo – Curso Excel Básico + Curso Excel Avançado – Acesso Vitalício

R$218,00 R$179,00

COMPRAR
Cursos

Curso Excel Master – Curso Excel Básico + Curso Excel Avançado + Curso VBA Excel + LP – Acesso Vitalício

R$357,00 R$249,00

COMPRAR
Cursos

Curso Excel PRO – Curso Excel Avançado + Curso VBA Excel + Lógica de programação – Acesso Vitalício

R$258,00 R$199,00

COMPRAR
Cursos

Curso Excel Web – Curso VBA Excel + Lógica de programação + Curso Web Scraping VBA- Acesso Vitalício

R$388,90 R$309,00

COMPRAR

58 Comentários

  1. weverson disse:

    Amigo, sua planilha esta dando erro de depuraçao, como posso arrumar isso?
    preciso desta planilha de cadastro de clientes

    • Marcos Rieper disse:

      Boa tarde Weverson,

      Qual o problema que está ocorrendo?

      Abraço

      Marcos Rieper

    • ImPrimo disse:

      Olá Marcos estou tendo problema em uma planilha excel vba sera que conseguiria me ajudar.

      Preciso fazer o Botao consultar ativar, no que esta errado?

      Private Sub BtnAlterar_Click()

      Dim EmpFound As Range
      With Range(“Funcionarios”)

      Set EmpFound = .Find(Me.Txtcliente1.Value)

      With Range(EmpFound.Address)

      .Offset(0, 2) = Me.Txtinformacao1.Value
      .Offset(0, 1) = Me.Txtend1.Value
      .Offset(0, 4) = Me.Txtuf1.Value
      .Offset(0, 5) = Me.Txtcep1.Value
      .Offset(0, 6) = Me.Txtemail1.Value
      .Offset(0, 7) = Me.Txttel1.Value
      .Offset(0, 8) = Me.Txttel1.Value
      .Offset(0, 9) = Me.txttipoimovel1.Value
      .Offset(0, 10) = Me.Txtend2_1.Value
      .Offset(0, 11) = Me.Txtbairro1.Value
      .Offset(0, 12) = Me.txttipo1.Value
      .Offset(0, 13) = Me.Txtvalor1.Value
      .Offset(0, 14) = Me.Txtcidade1.Value
      .Offset(0, 15) = Me.Txtuf2_1.Value
      .Offset(0, 16) = Me.txtpermuta1.Value
      .Offset(0, 17) = Me.txtdescricao1.Value

      On Error GoTo 0

      Columns.AutoFit
      MsgBox ” Alteração Efetuada com Sucesso”, vbInformation, ” Alteração de Clientes”

      End With

      End With

      End Sub

      Private Sub BtnC_Fechar_Click()
      Unload Me
      End Sub

      Private Sub BtnConsultar_Click()

      Dim Lin As Integer
      Lin = 2
      Do Until Sheets(“Plan1”).Cells(Lin, 11).Value = Empty

      If Sheets(“Plan1”).Cells(Lin, 11).Value = Lstdescricao1.Value Then
      Txtcliente1.Value = Sheets(“Plan1”).Cells(Lin, 1).Value
      Txtinformacao1.Value = Sheets(“Plan1”).Cells(Lin, 2).Value
      Txtend1.Value = Sheets(“Plan1”).Cells(Lin, 3).Value
      Txtcidade1.Value = Sheets(“Plan1”).Cells(Lin, 4).Value
      Txtuf1.Value = Sheets(“Plan1”).Cells(Lin, 5).Value
      Txtcep1.Value = Sheets(“Plan1”).Cells(Lin, 6).Value
      Txtemail1.Value = Sheets(“Plan1”).Cells(Lin, 7).Value
      Txttel1.Value = Sheets(“Plan1”).Cells(Lin, 8).Value
      Txttel2_1.Value = Sheets(“Plan1”).Cells(Lin, 9).Value
      txttipoimovel1.Value = Sheets(“Plan1”).Cells(Lin, 10).Value
      Txtend2_1.Value = Sheets(“Plan1”).Cells(Lin, 11).Value
      Txtbairro1.Value = Sheets(“Plan1”).Cells(Lin, 10).Value
      txttipo1.Value = Sheets(“Plan1”).Cells(Lin, 12).Value
      Txtvalor1.Value = Sheets(“Plan1”).Cells(Lin, 13).Value
      Txtcidade1.Value = Sheets(“Plan1”).Cells(Lin, 14).Value
      Txtuf2_1.Value = Sheets(“Plan1”).Cells(Lin, 15).Value
      txtpermuta1.Value = Sheets(“Plan1”).Cells(Lin, 16).Value
      txtdescricao1.Value = Sheets(“Plan1”).Cells(Lin, 17).Value

      End If

      Lin = Lin + 1
      Loop

      End Sub

      Private Sub Txtinformacao_Change()

      End Sub

      Private Sub UserForm_Activate()

      ‘Dim Lin As Integer
      ‘Lin = 2
      ‘Do Until Sheets(“Plan1”).Cells(Lin, 11).Value = Empty
      ‘Lstdescricao1.AddItem Sheets(“Plan1”).Cells(Lin, 11).Value
      ‘Lin = Lin + 1
      ‘Loop
      ‘End Sub

  2. weverson disse:

    Consegui arruma, eu acho.
    era erro nas imagens. nao sei como arrumar.

    • Roberto Farias disse:

      Se atente ao endereço da imagem. Na planilha está em D:\Blog Guia do Excel. Crie esse caminho e cole a pasta List Box dentro que não dará mais erros.

  3. Zeh disse:

    Não consigo abir a planilha…. pode me enviar por email?

  4. Paulo Cesar disse:

    Fui testar e o erro que está dando é em relação ao caminho da imagem. Fiz a seguinte alteração:
    no código do formulario frmCadastroStudents na Private Sub do botão cmdProximo na linha que indica o caminho onde está a imagem troquei pelo seguinte código:

    Me.Image1.Picture = LoadPicture(ThisWorkbook.Path & “\” & Worksheets(“Clientes”).Cells.Range(“M” & currentFind.Row + 1).Value)

    e na planilha, na aba clientes, no lugar do caminho completo da imagem coloquei apenas o nome da imagem (exemplo imagem.bmp).

    depois disso ta funcionando. Lembrando que tem que fazer a mesma coisa nos botoes de proximo e anterior e o de abrir o formulario.

  5. Fabio disse:

    Como fazer para ao selecionar o nome no formulário de pesquisa ele direcionar direto para o cadastro do cliente no frmCadastroStudents?

  6. Cláudio disse:

    Paulo Cesar,
    Teria como disponibilizar a planilha corrigida?
    claudiojr93@gmail.com

    Obrigado

    • Marcos Rieper disse:

      Bom dia Cláudio,

      Acho que o problema a que se refere deve ser por causa das imagens, elas tem que estar salvas em uma pasta, no caso altere na pasta Clientes a coluna Imagem alterando o local aonde estão salvos os arquivos e colocando os mesmos no endereço correto.

      Qualquer outro problema por favor me avise.

      Abraço

      Marcos Rieper

  7. Daniela disse:

    Olá!
    Como fazer para a Pesquisa abranger o texto de todas as colunas e não somente fazer a pesquisa na coluna B?

    Obrigada pela ajuda!

    • Marcos Rieper disse:

      Boa noite Daniela,

      Seria necessário realizar algumas mudanças no formulário que identificassem qual a coluna está sendo pesquisada, ou ainda fazer com que a pesquisa fosse realizada automaticamente por todas as linhas e colunas, mas para isso teria que alterar o formulário e o código VBA.

      Abraço

      Marcos Rieper

  8. Marcelo Costa disse:

    Deu erro em tempo de execução 71

    • Marcos Rieper disse:

      Boa noite Marcelo,

      Acredito que o problema que ocorreu possa ser porque a pasta com as imagens não foi definida no formulário. Você precisa salvar os arquivos e configurar este local na planilha.

      Abraço

      Marcos Rieper

  9. Ala parabens pela planilha.
    Preciso desta planilha, mais esta dando um erro de debug na linha com o seguinte codigo frmCadastroStudents.Image1.Picture = LoadPicture(Worksheets(“Clientes”) . Cells.Range (“M” & 1Linha).Value) como resolver este probleme se puder me esplicar o passo a passo sou novo trabalhando com o Vba. Desde ja obrigado.
    Aguardo

  10. Rafael disse:

    Bom dia Marcos,

    Quando faço a pesquisa da tudo certo, mas ao clicar no cliente não consigo visualizar o cadastro do mesmo.

  11. Rodrigo disse:

    Caro
    Gostei muito deste modelo, aliás todo o seu site tem muita informação.
    Neste modelo, achei interessante a aba SOBRE, onde coloca algumas informações.
    Gostaria de saber como proceder, em algumas planilhas, de limitar a área de uso da planilha, da forma como fez na planilha SOBRE.
    Abraço
    Rodrigo

  12. Marcello disse:

    Bom gostaria de acrescenta mais informaçoes, mais perguntas para acadastro isso é possivel? como? me ajude por favor

  13. Erion Simão disse:

    Olá, gostaria de incluir mais um campo, poderia me ajudar? Achei a planilha perfeita =)
    Obrigado. Aguardo seu email

  14. Marcos…

    Estou com problemas deu erro na linha 89 do programa, diz que a variaval do objeto ou do bloco With nao foi definida

    a linha é essa

    ” lLinha = currentFind.Row “

  15. ROMULO disse:

    Boa noite, alguém poderia enviar o arquivo corrigido e funcionando, preciso muito desse cadastro de clientes.

    • Marcos Rieper disse:

      Bom dia Rômulo,

      Para fazê-lo funcionar é necessário atualizar na planilha o local aonde estão salvas as imagens, caso contrário o sistema exibirá uma mensagem informando que não conseguiu carregá-la.

      Abraço

      Marcos Rieper

  16. Evaldo Soares disse:

    Ola.. Seu programa ficou Ótimo. Gostaria de inserir um código para que eu pudesse entrar no list box, encontrar o registro desejado, e ao invés de apenas consultar, com duplo clique enviasse a linha para o formulário de cadastro, com a intenção de fazer alguma alteração.

    Isso seria útil, por que se houver vários, ao invés de procurar pela ícone das setas ( avançar ) eu pudesse filtrar pelo nome no list-box.
    Infelizmente não conseguir construir esse código, aí sim o programa ficara nota 1000.
    Obrigado….

  17. atila disse:

    frmCadastroStudents.Image1.Picture = LoadPicture(Worksheets(“Clientes”).Cells.Range(“M” & lLinha).Value
    deu esse erro e agora?

  18. Parada disse:

    Olá Marcos, você é o cara. nO formulário não consego cadastrar, aparece de o registro nº1, consigo somente navegar por outro registros, també faço pesquisa, mas não cadastro.
    Prá mim seria melhor que na pesquisa fosse carregado o formulário e não somente o ListBox.
    ME AJUDEM.
    gRATO

  19. Rafael Soares disse:

    boa tarde Marcos!

    primeiro sensacional a planilha e mto objetiva… Usei mto ela até agora. Mas tive que fazer algumas alterações, acrescentei algumas informações e ficou bem legal. Só não estou conseguindo fazer o restante no formulário de impressão que criei… consegue me ajudar?

  20. Redner disse:

    Amigo… Teria como colocar a opção de fazer download da imagem?

  21. maksue lima disse:

    Bom dia Marcos, é possível realizar a pesquisa de cadastro e apos localizar algum registro, selecionar este e assim abrir uma nova ABA do excel?

  22. Abri a planilha, ao clicar na aba Menu e sobre a celula “clientes” deu o seguinte erro: Erro em tempo de execução, 76 – Caminho nao localizado.
    O que fazer nesse caso?

  23. Everton disse:

    Bom dia Marcos. Parabéns pelo excelente trabalho.
    Marcos eu queria te pedir ajuda. Estou montando uma planilha de cadastro de máquinas, e nessa planilha cada máquina possui um banco de horas, que algumas delas chegam a somar 2428h:30min, na planilha do excel beleza, consigo fazer a célula me apresentar essas horas conforme coloquei, só que no formulário VBA que criei quando eu busco o cadastro, o formulário me retornar um valor totalmente diferente do que consta na tabela do excel, já revirei a internet tentando buscar um código que faça o fomulário vba apesentar as horas exatas como demonstrado acima, mas não encontrei, só encontro o formato de apresentação de horas até 24h, acima disso não encontro. Você pode me ajudar ? Obrigado desde já.

  24. Fábio Gama disse:

    Prezados, saudações!

    Por gentileza, gostaria que alguém gentilmente me ajudasse. Sou iniciante e preciso de uma macro que localize o conteúdo (variável) da célula A1 na primeira coluna de uma lista (A2:A20000) e, após localizar tal conteúdo, no primeiro resultado (este conteúdo pode aparecer mais de uma vez, mas sempre ordenado), atribua o conteúdo digitado na célula C1 para a célula vizinha à direita da primeira célula encontrada (ou mesmo para todas encontradas). Para exemplificar, imagine que selecionei a coluna ‘A” e dei um CRTL+L e digitei o valor contido em A1, após a primeira localização, desloco-me para a célula à direita desta encontrada e escrevo o conteúdo da célula C1. Desde já agradeço pela valiosa colaboração!

  25. Hendryws disse:

    Quero o link para o download. fiz o cadastro mas não me enviaram

  26. eduardo disse:

    olá, onde crio a pasta das imagens e como defino ela na linha de comando: frmCadastroStudents.Image1.Picture = LoadPicture(Worksheets(“Clientes”).Cells.Range(“M” & lLinha).Value)

  27. andrey cabral disse:

    oi boa tarde
    eu ja fez de userform em vba excel
    ja esta tudo correto de salvar imagem\
    ainda nao abrir de imagem e pesquisar de falta foto nao consegui
    so pesquisar de foto

  28. EVALDO SOARES DE ALMEIDA disse:

    Olá Marcos…

    Gostaria de ver uma observação. Como faço para que o sistema desconsidere letras maiúsculas ou minusculas e os acentos nas buscas, ou seja, se eu digitar antonio, ele possa buscar o Antônio…

    Obrigado !!!

    • Evaldo disse:

      Olá Marcos,

      sobre a condição da pesquisa conseguir enviar para o formularios de cadastro a linha encontrada para fazermos alteração, vc conseguiu desenvolver alguma coisa..
      Obrigado !

  29. Jovaldo Borges disse:

    GOSTEI MUITO

  30. Anderson disse:

    Marcos, excelente planilha, sou iniciante no VBA mas tenho muita motivação em aprender, poderia me ajudar nessa planilha, pois ao pesquisa o cadastro ele só aceita quando aciona a tecla SHIFT, gostaria de alterar o código para que quando apertasse a tecla ENTER ele trouxesse o resultado. obrigado.

  31. mauro domingues disse:

    nao to conseguindo acertar o codigo com as imgens tem como vc me enviar com correçao, pois o erro ta nesse parametro: ” frmCadastroStudents.Image1.Picture = LoadPicture(Worksheets(“Clientes”).Cells.Range(“M” & lLinha).Value)”. gostaria de saber o que é essa imagem 1.
    obrigado!!!

  32. Fabio Santos disse:

    Boa Noite,

    Está dando erro no tempo de execução 71: o disco não está pronto. Aí eu clico em depurar que me leva neste código abaixo.

    frmCadastroStudents.Image1.Picture = LoadPicture(Worksheets(“Clientes”).Cells.Range(“M” & lLinha).Value)

    teria como arrumar, obrigado.

  33. Emerson disse:

    Bom dia Marcos Rieper! Gostaria de conversar com você a respeito da possibilidade de algumas modificações nesta planilha, a fim de que a use no trabalho. Parabéns pelo trabalho! Desde já agradeço pela atenção.

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

Esse site utiliza o Akismet para reduzir spam. Aprenda como seus dados de comentários são processados.

Inscreva-se no nosso canal do Youtube!


Junte-se ao nosso canal do Youtube. Começamos em abril de 2016, mas já temos mais de 06:00 h de treinamentos gratuitos e este número irá aumentar. Vídeos novos todos os sábados.