Bom dia Murilo.
Muito obrigado pela resposta.
Quanto a demora não tem problema.
Apesar da minha necessidade entendo que você tem coisa importante a fazer diariamente.
Eu testei a planilha e ficou show de bola.
Mas me desculpe ainda tenho uma dúvida.
Analisei as rotinas mas devido ao meu pouco conhecimento não consegui resolver.
Gostaria de saber como fazer aparecer todas as linhas da planilha na list box quando e feito a pesquisa pois agora só aparece alguns campos.
Copiei todas as rotinas e colei no tópico talvez assim não lhe causarei tanto incomodo.
Por gentileza poderia me dizer em qual rotina devo alterar para que apareça todas as linhas.
Mais uma vez agradeço a sua generosidade e espero poder retribuir.
Abraços
Fabio
Private Sub cmd_Pesquisar_Click()
Dim bool As Boolean 'Variável utilizada na Function 'listar' para comparar o retorno da função
Call listar(txt_NoRegistro.Text, txt_Cliente.Text, bool)
If bool = True Then 'Se ao menos um registro foi encontrado na pesquisa da Function:
Unload Me
lista.Show
Else:
End If
End Sub
Private Sub cmd_Voltar_Click()
Unload Me
pesquisar.Show
End Sub
Private Sub UserForm_Initialize()
Dim iLastRow As Long
iLastRow = Sheets("Lista").Cells(Cells.Rows.Count, "A").End(xlUp).Row
With ListPesquisa
.RowSource = "Lista!A1:O" & iLastRow 'Fonte de Dados
'Abaixo, defino manualmente o tamanho de cada coluna do ListBox:
.ColumnWidths = "2,8 cm; 2,5 cm; 3,1 cm; 2,5 cm; 2 cm; 2,5 cm; 2,5 cm; 3,1 cm; 2cm; 2cm; 2cm; 3cm"
End With
End Sub
Private Sub cmd_Fechar_Click()
Unload Me
End Sub
Private Sub cmd_Gravar_Click()
Dim iLastRow As Integer
iLastRow = ActiveSheet.UsedRange.Rows.Count 'Conta o número de linhas preenchidas no arquivo
iLastRow = iLastRow + 1 'valor de iLastRow será a próxima célula (que estará vazia)
'Preencher as células vazias com os valores das TextBoxes:
'-----------
Range("A" & iLastRow).Value = txt_NoRegistro.Text
Range("C" & iLastRow).Value = txt_Cliente.Text
Range("D" & iLastRow).Value = txt_Dia.Text
Range("H" & iLastRow).Value = txt_Responsavel.Text
Range("I" & iLastRow).Value = txt_Control1.Text
Range("J" & iLastRow).Value = txt_Control2.Text
Range("M" & iLastRow).Value = cboMotivo1.Text
Range("N" & iLastRow).Value = cboMotivo2.Text
Range("O" & iLastRow).Value = cboMotivo3.Text
Range("L" & iLastRow).Value = txt_Nascimento.Text
'-----------
ActiveWorkbook.Save 'Salva a pasta de trabalho
End Sub
Private Sub cmd_Limpar_Click()
For Each ctl In Me.Controls 'Para cada objeto de controle
If TypeName(ctl) = "TextBox" Or _
TypeName(ctl) = "ComboBox" Then 'Se o tipo for TextBox OU ComboBox (combo de Motivos)
ctl.Text = vbNullString 'Limpa o conteúdo
End If
Next ctl 'Próximo objeto de controle
txt_Dia.Text = Format(Now, "dd/mm/yyyy") 'Redefine o dia
End Sub
Private Sub cmd_Pesquisar_Click()
Dim bool As Boolean 'Variável utilizada na Function 'listar' para comparar o retorno da função
Call listar(txt_NoRegistro.Text, txt_Cliente.Text, bool)
If bool = True Then 'Se ao menos um registro foi encontrado na pesquisa da Function:
Unload Me
lista.Show
Else:
End If
End Sub
Private Sub UserForm_Click()
'Cria as tags para cada campo (a tag será o valor da coluna na linha 1)
'-----------
txt_Cliente.Tag = "Nome Do Cliente"
txt_NoRegistro.Tag = "No Registro"
txt_Dia.Tag = "Dia Do Registro"
txt_Responsavel.Tag = "Nome Do Responsável"
txt_Control1.Tag = "Controle 1"
txt_Control2.Tag = "Controle 2"
cboMotivo1.Tag = "Motivo 1"
cboMotivo2.Tag = "Motivo 2"
cboMotivo3.Tag = "Motivo 3"
txt_Nascimento.Tag = "Data De Nascimento"
'-----------
End Sub
Private Sub UserForm_Activate()
txt_Dia.Text = Format(Now, "dd/mm/yyyy")
End Sub
Function listar(no_reg As String, nome_cli As String, bool) As Boolean
Dim celula As Range
Dim achou As Boolean 'Será utilizado para verificar se a macro possuirá ao menos 1 registro na lista
bool = False 'Atualiza o valor de bool para falso
Sheets("Lista").Rows.Clear 'Limpa a Lista que contém os dados da Pesquisa
Sheets("Dados").Rows("1:1").Copy Sheets("Lista").Rows("1:1") 'Copia o cabeçalho (linha 1) da sheet Dados
If no_reg = "" And nome_cli = "" Then
MsgBox "O cliente e/ou nº de registro não foi informado", vbInformation
Exit Function 'Sai da macro, caso as textbox estejam vazias (não é possível realizar o filtro)
Else:
achou = False 'Valor da booleana será falso
iLastRow = Sheets("Dados").UsedRange.Rows.Count 'Conta o número de linhas preenchidas no arquivo
For Each celula In Sheets("Dados").Range("A2:A" & iLastRow)
If celula.Value = no_reg Or celula.Offset(0, 2).Value = nome_cli Then 'Compara o valor do textbox com as celulas
achou = True 'Achou ao menos um registro para a lista
With Sheets("Lista")
.Activate 'Seleciona a sheet Lista
celula.EntireRow.Copy .Rows(.UsedRange.Rows.Count + 1) 'Copia a célula atual do laço para a próxima celula em branco da lista
End With
End If
Next
If achou = False Then 'Se não foram encontrados nenhum registro com o nº de registro e cliente informados:
MsgBox "Não foram encontrados nenhum registro com o cliente '" & pesquisar.txt_Cliente.Text & _
"' ou nº de registro '" & pesquisar.txt_NoRegistro.Text & "'"
bool = False 'False (não continuará a macro de pesquisa, pois não foram encontrados resultados)
Exit Function 'Sai da Macro
Else: 'Caso a sheet Lista possua ao menos um registro:
'Unload Me 'Fecha o Form
bool = True 'Continuará a pesquisa
Sheets("Dados").Select
End If
End If
End Function
Postado : 01/05/2014 8:35 am