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.

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

Download “Cadastro de clientes com VBA Excel com imagem e pesquisa” ListBox.zip – Baixado 239 vezes – 3 MB

Abraço

Marcos Rieper

51 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.

  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 !!!

  29. Jovaldo Borges disse:

    GOSTEI MUITO

Deixe uma resposta

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

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.