Botão Pesquisar VBA não acessa formulário

[MooM]

Boa tarde galera!

 

 

peguei um código na net para gerar um formulário de cadastro de clientes.

Só que o botão "PESQUISAR" não funciona de jeito não, eu clico e não acontece nada.

 

 

 2 Formulários (1) Cadastro : 3 botões (INSERIR) (PESQUISAR) (LIMPAR)

(2) Pesquisar: 1 - listbox + 1 lalbel

 

Poderiam me ajudar, por favor.

 

Seguem os códigos:

Private Sub btn_Inserir_Click()Dim campos As VariantDim k As Bytecampos = Array(txt_Codigo, txt_Nome, txt_Linha1, txt_Linha2, txt_Linha3, txt_Linha4, txt_Linha5)Application.ScreenUpdating = FalseSheets("Cadastro").ActivateRange("a2").SelectDo While IsEmpty(ActiveCell) = False    ActiveCell.Offset(1, 0).SelectLoopFor k = 0 To 6    ActiveCell.Offset(0, k).Value = campos(k).ValueNext kMsgBox ("Cliente '") & campos(1) & "' Cadastrado com Sucesso!", vbInformation, "Confirmação de Cadastro"For k = 0 To 6    campos(k).Value = EmptyNext kCells.EntireColumn.AutoFittxt_Codigo = Application.WorksheetFunction.CountA(Range("a1:a500"))Application.ScreenUpdating = TrueSheets("SI - AIR").ActivateRange("M10").SelectActiveWorkbook.SAVEEnd SubPrivate Sub btn_Limpar_Click()txt_Nome = Emptytxt_Linha1 = Emptytxt_Linha2 = Emptytxt_Linha3 = Emptytxt_Linha4 = Emptytxt_Linha5 = Emptytxt_Codigo = Application.WorksheetFunction.CountA(Range("a1:a500"))End SubPrivate Sub btn_Pesquisar_Click()End SubPrivate Sub txt_Codigo_AfterUpdate()Dim intervalo As RangeDim codigo As Integercodigo = txt_CodigoSet intervalo = Range("a2:i500")txt_Nome = Application.WorksheetFunction.VLookup(codigo, intervalo, 1, 0)txt_Linha1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 2, 0)txt_Linha2 = Application.WorksheetFunction.VLookup(codigo, intervalo, 3, 0)txt_Linha3 = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, 0)txt_Linha4 = Application.WorksheetFunction.VLookup(codigo, intervalo, 5, 0)txt_Linha5 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, 0)End SubPrivate Sub UserForm_Initialize()Sheets("Cadastro").Activatetxt_Codigo = Application.WorksheetFunction.CountA(Range("a1:a500"))Sheets("SI - AIR").ActivateRange("M10").SelectEnd SubPrivate Sub ListBox_PesquisarNome_Click()End SubPrivate Sub ListBox_PesquisarNome_DblClick(ByVal Cancel As MSForms.ReturnBoolean)Dim valor_lista As IntegerDim selecao As Integerselecao = ListBox_PesquisarNome.ListIndexvalor_lista = ListBox_PesquisarNome.List(selecao, 0)With UserForm_Cadastro    .txt_Codigo = valor_lista    .txt_Codigo.SetFocus    .txt_Nome.SetFocusEnd WithUnload MeEnd SubPrivate Sub UserForm_Click()End SubPrivate Sub UserForm_Initialize()With Sheets("Cadastro").UsedRange     ListBox_PesquisarNome.ColumnCount = 2     ListBox_PesquisarNome.RowSource = .Adress   End Withlbl_TotalRegistro.Caption = "Total de Registro(s): " & ListBox_PesquisarNome.ListCount - 1End Sub

[Basole]

Aparentemente nao há comando (rotina) no Evento do botão Pesquisar : "..Button_Click() :

Private Sub btn_Pesquisar_Click() End Sub

Se puder postar seu arquivo fica mais fácil uma analise precisa; 

[MooM]

Obrigado pela ajuda.

 

Veja se consegue baixar o arquivo no link abaixo porque eu n tenho permissão pra enviar por aqui.

 

 

http://www.4shared.com/file/XnEHywqpce/teste__1_.html

[Patropi]

MooM

 

Você tem permissão para anexar sim, você não conseguiu, porque não compactou o Arquivo. ( Arquivos com Macros só são aceitos compactados)

 

[]s

 

Patropi - Moderador

[MooM]

Ahh beleza Patropi...obrigado pela informação.

Obrigado pela ajuda.

 

Veja se consegue baixar o arquivo no link abaixo porque eu n tenho permissão pra enviar por aqui.

 

 

http://www.4shared.com/file/XnEHywqpce/teste__1_.html

teste.rar

[Basole]

@MooM

Vendo aqui a disposicao dos seu componentes, ja existe uma rotina de pesquisa no evento AfterUpdate

( que é executada quando voce digita um codigo no campo [codigo] e tecla o [tab] ou clica em outro campo.)

 

Fiz a alteracao nesta rotina, referenciando a aba cadastro como local e o intervalo de pesquisa: 

 

Private Sub txt_Codigo_AfterUpdate()
    Dim intervalo As Range
    Dim codigo As Integer

    codigo = txt_Codigo
    Set intervalo = Sheets("Cadastro").Range("A2:G500")

    txt_Nome = Application.WorksheetFunction.VLookup(codigo, intervalo, 1, 0)
    txt_Linha1 = Application.WorksheetFunction.VLookup(codigo, intervalo, 2, 0)
    txt_Linha2 = Application.WorksheetFunction.VLookup(codigo, intervalo, 3, 0)
    txt_Linha3 = Application.WorksheetFunction.VLookup(codigo, intervalo, 4, 0)
    txt_Linha4 = Application.WorksheetFunction.VLookup(codigo, intervalo, 5, 0)
    txt_Linha5 = Application.WorksheetFunction.VLookup(codigo, intervalo, 6, 0)
    
End Sub

 

Sendo assim, neste caso o botão [Pesquisa],é dispensável. A nao ser q queira usa-lo,

então recorte o codigo deste evento e cole no evento _click do Botao.

[MooM]

Então, na verdade eu quero usar o botão consulta para abrir o formulário PESQUISAR NOME com o list box pra que eu possa selecionar o cadastro que eu quero e depois poder altera-lo quando a macro fizer o retorno dos dados da pesquisa no formulário de cadastro.

 

Veja o link que eu peguei pra montar essa parte toda. Eu fiz(acho) igual ao video, so que o formulario de pesquisa não abre...

 

http://www.escolaexcel.com.br/2013/08/cadastro-de-clientes-com-pesquisar.html

 

veja video 3

[Basole]

@MooM

Bom voce não esclareceu claramente o que queria,

de qq. forma veja se é isso que precisa: 

 

 

 

 

teste (1)-v1.zip

[MooM]

Basole, bom dia!

 

 

Desculpe não ter expressado corretamente, mas era exatamente isso que eu precisava.

 

Muito obrigado pela ajuda. abc