Cadastro de clientes VBA Excel com Imagem e Pesquisa

45
Cadastro de clientes VBA Excel com Imagem e Pesquisa

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

FormularioVBAPesquisa

Este exemplo de planilha complementa o artigo https://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 <= iTotalLinhas And IsNumeric(Worksheets("Clientes").Cells(lLinha - 1, 1)) Then
            lsLocalizaRegistroStudent (CLng(Worksheets("Clientes").Cells(lLinha - 1, 1)))
        End If
 
        If lLinha = 2 And iTotalLinhas > 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

DIGITE O SEU EMAIL PARA FAZER O DOWNLOAD DOS ARQUIVOS:

Seu nome (obrigatório)

Seu e-mail (obrigatório)

Abraço

Marcos Rieper

45 COMENTÁRIOS

    • 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

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

    • 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

    • 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

    • 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

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

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

    • 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

  4. 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….

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

  6. 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?

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

  8. 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á.

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

DEIXE UMA RESPOSTA

Please enter your comment!
Please enter your name here