Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Formulario de pesquisa
Formulario de pesquisa
Olá a todos do Forum, sou novato no VBA e vasculhando na net a respeito encontrei este codigo que em suma esta adaptado para a minha planilha, o probleminha e que na pesquisa e vasculha a planilha por completo e me retorna tudo mais tudo mesmo com um certo caractere, o que eu quero saber como faço para que esta pesquisa ocorra somente na coluna A na D e I da planilha ?
Segue o codigo e desde já acrescento que este forum e uns dos melhores da NET que abordam o Excel e suas infinitas possibilidades.
Public MatrizResultados As Variant
Public Total_Ocorrencias As Long
Private Sub btn_Procurar_Click()
If Me.txt_Procurar.Value = "" Then
MsgBox "Digite um valor para a pesquisa"
Else
Call ProcuraPersonalizada(Me.txt_Procurar.Value)
End If
End Sub
Private Sub SpinButton1_Change()
Dim Linha As Long
Dim TotalOcorrencias As Long
TotalOcorrencias = SpinButton1.Max + 1
Linha = MatrizResultados(SpinButton1.Value)
Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
TextBox1.Text = Plan1.Cells(Linha, 1).Value
TextBox2.Text = Plan1.Cells(Linha, 2).Value
TextBox3.Text = Format(Plan1.Cells(Linha, 3).Value, "h:mm;@")
TextBox4.Text = Plan1.Cells(Linha, 4).Value
TextBox5.Text = Plan1.Cells(Linha, 5).Value
TextBox6.Text = Plan1.Cells(Linha, 6).Value
TextBox7.Text = Plan1.Cells(Linha, 7).Value
TextBox8.Text = Plan1.Cells(Linha, 8).Value
TextBox9.Text = Plan1.Cells(Linha, 9).Value
TextBox10.Text = Plan1.Cells(Linha, 10).Text
TextBox11.Text = Plan1.Cells(Linha, 11).Text
TextBox12.Text = Plan1.Cells(Linha, 12).Text
TextBox15.Text = Plan1.Cells(Linha, 15).Text
TextBox16.Text = Plan1.Cells(Linha, 16).Value
TextBox17.Text = Plan1.Cells(Linha, 17).Value
TextBox18.Text = Plan1.Cells(Linha, 18).Value
TextBox34.Text = Plan1.Cells(Linha, 34).Text
TextBox36.Text = Plan1.Cells(Linha, 36).Text
TextBox37.Text = Plan1.Cells(Linha, 37).Text
TextBox38.Text = Plan1.Cells(Linha, 38).Text
TextBox39.Text = Plan1.Cells(Linha, 39).Text
TextBox40.Text = Plan1.Cells(Linha, 40).Text
TextBox41.Text = Plan1.Cells(Linha, 41).Text
End Sub
Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim Resultados As String
'Executa a busca
Set Busca = Plan1.Cells.Find(What:=TermoPesquisado, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
'Caso tenha encontrado alguma ocorrência...
If Not Busca Is Nothing Then
Primeira_Ocorrencia = Busca.Address
Resultados = Busca.Row 'Lista o primeiro resultado na variavel
'Neste loop, pesquisa todas as próximas ocorrências para
'o termo pesquisado
Do
Set Busca = Plan1.Cells.FindNext(After:=Busca)
'Condicional para não listar o primeiro resultado
'pois já foi listado acima
If Not Busca.Address Like Primeira_Ocorrencia Then
Resultados = Resultados & ";" & Busca.Row
End If
Loop Until Busca.Address Like Primeira_Ocorrencia
MatrizResultados = Split(Resultados, ";")
'Atualiza dados iniciais no formulário
SpinButton1.Max = UBound(MatrizResultados) 'Valor maximo do seletor de registros
'habilita o seletor de registro
SpinButton1.Enabled = True
'indicador do seletor de registros
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultados) + 1
'Box com o conteudo encontrado
TextBox1.Text = Plan1.Cells(MatrizResultados(0), 1).Value
TextBox2.Text = Plan1.Cells(MatrizResultados(0), 2).Value
TextBox3.Text = Format(Plan1.Cells(MatrizResultados(0), 3).Value, "h:mm;@")
TextBox4.Text = Plan1.Cells(MatrizResultados(0), 4).Value
TextBox5.Text = Plan1.Cells(MatrizResultados(0), 5).Value
TextBox6.Text = Plan1.Cells(MatrizResultados(0), 6).Value
TextBox7.Text = Plan1.Cells(MatrizResultados(0), 7).Value
TextBox8.Text = Plan1.Cells(MatrizResultados(0), 8).Value
TextBox9.Text = Plan1.Cells(MatrizResultados(0), 9).Value
TextBox10.Text = Plan1.Cells(MatrizResultados(0), 10).Text
TextBox11.Text = Plan1.Cells(MatrizResultados(0), 11).Text
TextBox12.Text = Plan1.Cells(MatrizResultados(0), 12).Text
TextBox15.Text = Plan1.Cells(MatrizResultados(0), 15).Text
TextBox16.Text = Plan1.Cells(MatrizResultados(0), 16).Value
TextBox17.Text = Plan1.Cells(MatrizResultados(0), 17).Value
TextBox18.Text = Plan1.Cells(MatrizResultados(0), 18).Text
TextBox34.Text = Plan1.Cells(MatrizResultados(0), 34).Text
TextBox36.Text = Plan1.Cells(MatrizResultados(0), 36).Text
TextBox37.Text = Plan1.Cells(MatrizResultados(0), 37).Text
TextBox38.Text = Plan1.Cells(MatrizResultados(0), 38).Text
TextBox39.Text = Plan1.Cells(MatrizResultados(0), 39).Text
TextBox40.Text = Plan1.Cells(MatrizResultados(0), 40).Text
TextBox41.Text = Plan1.Cells(MatrizResultados(0), 41).Text
Else 'Caso nada tenha sido encontrado, exibe mensagem informativa
SpinButton1.Enabled = False 'desabilita o seletor de registros
Label_Registros_Contador.Caption = "" 'zera os resultados encontrados
'limpa os campos do formulário
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox15.Text = ""
TextBox16.Text = ""
TextBox17.Text = ""
TextBox18.Text = ""
TextBox34.Text = ""
TextBox36.Text = ""
TextBox37.Text = ""
TextBox38.Text = ""
TextBox39.Text = ""
TextBox40.Text = ""
TextBox41.Text = ""
MsgBox "Nenhuma Ocorrencia para '" & TermoPesquisado & "'encontrado."
End If
End Sub
Private Sub txt_Procurar_Change()
End Sub
Private Sub UserForm_Initialize()
SpinButton1.Enabled = False
Label_Registros_Contador.Caption = ""
End Sub
Segue o codigo e desde já acrescento que este forum e uns dos melhores da NET que abordam o Excel e suas infinitas possibilidades.
Public MatrizResultados As Variant
Public Total_Ocorrencias As Long
Private Sub btn_Procurar_Click()
If Me.txt_Procurar.Value = "" Then
MsgBox "Digite um valor para a pesquisa"
Else
Call ProcuraPersonalizada(Me.txt_Procurar.Value)
End If
End Sub
Private Sub SpinButton1_Change()
Dim Linha As Long
Dim TotalOcorrencias As Long
TotalOcorrencias = SpinButton1.Max + 1
Linha = MatrizResultados(SpinButton1.Value)
Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
TextBox1.Text = Plan1.Cells(Linha, 1).Value
TextBox2.Text = Plan1.Cells(Linha, 2).Value
TextBox3.Text = Format(Plan1.Cells(Linha, 3).Value, "h:mm;@")
TextBox4.Text = Plan1.Cells(Linha, 4).Value
TextBox5.Text = Plan1.Cells(Linha, 5).Value
TextBox6.Text = Plan1.Cells(Linha, 6).Value
TextBox7.Text = Plan1.Cells(Linha, 7).Value
TextBox8.Text = Plan1.Cells(Linha, 8).Value
TextBox9.Text = Plan1.Cells(Linha, 9).Value
TextBox10.Text = Plan1.Cells(Linha, 10).Text
TextBox11.Text = Plan1.Cells(Linha, 11).Text
TextBox12.Text = Plan1.Cells(Linha, 12).Text
TextBox15.Text = Plan1.Cells(Linha, 15).Text
TextBox16.Text = Plan1.Cells(Linha, 16).Value
TextBox17.Text = Plan1.Cells(Linha, 17).Value
TextBox18.Text = Plan1.Cells(Linha, 18).Value
TextBox34.Text = Plan1.Cells(Linha, 34).Text
TextBox36.Text = Plan1.Cells(Linha, 36).Text
TextBox37.Text = Plan1.Cells(Linha, 37).Text
TextBox38.Text = Plan1.Cells(Linha, 38).Text
TextBox39.Text = Plan1.Cells(Linha, 39).Text
TextBox40.Text = Plan1.Cells(Linha, 40).Text
TextBox41.Text = Plan1.Cells(Linha, 41).Text
End Sub
Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim Resultados As String
'Executa a busca
Set Busca = Plan1.Cells.Find(What:=TermoPesquisado, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
'Caso tenha encontrado alguma ocorrência...
If Not Busca Is Nothing Then
Primeira_Ocorrencia = Busca.Address
Resultados = Busca.Row 'Lista o primeiro resultado na variavel
'Neste loop, pesquisa todas as próximas ocorrências para
'o termo pesquisado
Do
Set Busca = Plan1.Cells.FindNext(After:=Busca)
'Condicional para não listar o primeiro resultado
'pois já foi listado acima
If Not Busca.Address Like Primeira_Ocorrencia Then
Resultados = Resultados & ";" & Busca.Row
End If
Loop Until Busca.Address Like Primeira_Ocorrencia
MatrizResultados = Split(Resultados, ";")
'Atualiza dados iniciais no formulário
SpinButton1.Max = UBound(MatrizResultados) 'Valor maximo do seletor de registros
'habilita o seletor de registro
SpinButton1.Enabled = True
'indicador do seletor de registros
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultados) + 1
'Box com o conteudo encontrado
TextBox1.Text = Plan1.Cells(MatrizResultados(0), 1).Value
TextBox2.Text = Plan1.Cells(MatrizResultados(0), 2).Value
TextBox3.Text = Format(Plan1.Cells(MatrizResultados(0), 3).Value, "h:mm;@")
TextBox4.Text = Plan1.Cells(MatrizResultados(0), 4).Value
TextBox5.Text = Plan1.Cells(MatrizResultados(0), 5).Value
TextBox6.Text = Plan1.Cells(MatrizResultados(0), 6).Value
TextBox7.Text = Plan1.Cells(MatrizResultados(0), 7).Value
TextBox8.Text = Plan1.Cells(MatrizResultados(0), 8).Value
TextBox9.Text = Plan1.Cells(MatrizResultados(0), 9).Value
TextBox10.Text = Plan1.Cells(MatrizResultados(0), 10).Text
TextBox11.Text = Plan1.Cells(MatrizResultados(0), 11).Text
TextBox12.Text = Plan1.Cells(MatrizResultados(0), 12).Text
TextBox15.Text = Plan1.Cells(MatrizResultados(0), 15).Text
TextBox16.Text = Plan1.Cells(MatrizResultados(0), 16).Value
TextBox17.Text = Plan1.Cells(MatrizResultados(0), 17).Value
TextBox18.Text = Plan1.Cells(MatrizResultados(0), 18).Text
TextBox34.Text = Plan1.Cells(MatrizResultados(0), 34).Text
TextBox36.Text = Plan1.Cells(MatrizResultados(0), 36).Text
TextBox37.Text = Plan1.Cells(MatrizResultados(0), 37).Text
TextBox38.Text = Plan1.Cells(MatrizResultados(0), 38).Text
TextBox39.Text = Plan1.Cells(MatrizResultados(0), 39).Text
TextBox40.Text = Plan1.Cells(MatrizResultados(0), 40).Text
TextBox41.Text = Plan1.Cells(MatrizResultados(0), 41).Text
Else 'Caso nada tenha sido encontrado, exibe mensagem informativa
SpinButton1.Enabled = False 'desabilita o seletor de registros
Label_Registros_Contador.Caption = "" 'zera os resultados encontrados
'limpa os campos do formulário
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox15.Text = ""
TextBox16.Text = ""
TextBox17.Text = ""
TextBox18.Text = ""
TextBox34.Text = ""
TextBox36.Text = ""
TextBox37.Text = ""
TextBox38.Text = ""
TextBox39.Text = ""
TextBox40.Text = ""
TextBox41.Text = ""
MsgBox "Nenhuma Ocorrencia para '" & TermoPesquisado & "'encontrado."
End If
End Sub
Private Sub txt_Procurar_Change()
End Sub
Private Sub UserForm_Initialize()
SpinButton1.Enabled = False
Label_Registros_Contador.Caption = ""
End Sub
Re: Formulario de pesquisa
Colega,
Creio que substituindo este código:
Por este:
Deve funcionar.
Abraços
Creio que substituindo este código:
Código: Selecionar todos
'Executa a busca
Set Busca = Plan1.Cells.Find(What:=TermoPesquisado, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Código: Selecionar todos
'Executa a busca
Set Busca = Plan1.Range("A:D").Find(What:=TermoPesquisado, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Abraços
Re: Formulario de pesquisa
Caro colega , obrigado pela ajuda porem não funcionou com este codigo. a pesquisa continua em toda a planilha.
Re: Formulario de pesquisa
Master obrigado pelo empenho em ajudar, resolvir mudar o projeto por completo utilizando um codigo disponibilizado no site Exceldoseujeito efetuando alguma adaptações a minha necessidade, inclusive recomendo a todos do forum, segue link da pagina; http://www.exceldoseujeito.com.br/2011/ ... /#more-458
Como sempre falta alguma coisa;
Tentei que o textbox na consulta me retorna-se a cor de preenchimento da celula com este codigo porem não deu certo sabes me dizer onde estou errando ?
With Me.TextBox3
.Value = Format(WorksheetFunction.Text(Plan1.Cells(linha, 3).Value 'retorna o valor da celula
.BackColor = Plan1.Cells(linha, 3).Interior.Color 'Retorna a cor de preenchimeto da celula
.ForeColor = Plan1.Cells(linha, 3).Font.Color 'Retorna a Cor da fonte da celula
End With
O codigo original e este, tentei anexar a planilha para facilitar não consegui devido o tamanho da mesma.
Public MatrizResultadosLinha As Variant
Public MatrizResultadosPlanilha As Variant
Public Total_Ocorrencias As Long
Public sCriterioDaBusca As String
Public sAcaoRequerida As String
Private Sub btn_Adicionar_Click()
'Definir a ação do comando
sAcaoRequerida = "Adicionar"
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(True)
End Sub
Private Sub btn_Cancelar_Click()
'Definir a ação do comando
sAcaoRequerida = ""
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(False)
'Recarrega os controles com os valores ativos na memória
Call SpinButton1_Change
txt_Procurar.Text = sCriterioDaBusca
End Sub
Private Sub btn_Editar_Click()
'Definir a ação do comando
sAcaoRequerida = "Editar"
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(True)
End Sub
Private Sub btn_Excluir_Click()
Dim sLinha As Long
Dim iPlanilha As Integer
If MsgBox("Tem certeza que deseja eliminar este cadastro do sistema?", vbDefaultButton2 + vbQuestion + vbYesNo, Me.Caption) = vbYes Then
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
'Exclui a linha do registro
Sheets(iPlanilha).Rows(sLinha).Delete
'Salva o arquivo
ThisWorkbook.Save
'Recarrega os registros para o formulário
txt_Procurar.Text = sCriterioDaBusca
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
End Sub
Private Sub btn_Procurar_Click()
If txt_Procurar.Text = "" Then
MsgBox "Digite um valor para a pesquisa"
Else
sCriterioDaBusca = txt_Procurar.Text
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
End Sub
Private Sub btn_Salvar_Click()
Dim sLinha As Long
Dim iPlanilha As Integer
'Realiza a ação apropriada
Select Case sAcaoRequerida
Case "Adicionar"
With Sheets(Combo_OndeSalvar.Text)
sLinha = .Range("A:A").SpecialCells(xlLastCell).Row + 1 'Pega a próxima linha vazia para cadastrar novo
'Grava os novos valores informados no formulário para a planilha base de dados
.Cells(sLinha, 1).Value = TextBox1.Text
.Cells(sLinha, 2).Value = TextBox2.Text
.Cells(sLinha, 3).Value = TextBox3.Text
.Cells(sLinha, 4).Value = TextBox4.Text
.Cells(sLinha, 5).Value = TextBox5.Text
.Cells(sLinha, 6).Value = TextBox6.Text
.Cells(sLinha, 7).Value = TextBox7.Text
.Cells(sLinha, 8).Value = TextBox8.Text
.Cells(sLinha, 9).Value = TextBox9.Text
.Cells(sLinha, 10).Value = TextBox10.Text
.Cells(sLinha, 11).Value = TextBox11.Text
.Cells(sLinha, 12).Value = TextBox12.Text
.Cells(sLinha, 16).Value = TextBox16.Text
.Cells(sLinha, 18).Value = TextBox18.Text
.Cells(sLinha, 34).Value = TextBox34.Text
.Cells(sLinha, 35).Value = TextBox35.Text
.Cells(sLinha, 36).Value = TextBox36.Text
.Cells(sLinha, 37).Value = TextBox37.Text
.Cells(sLinha, 38).Value = TextBox38.Text
.Cells(sLinha, 39).Value = TextBox39.Text
.Cells(sLinha, 40).Value = TextBox40.Text
.Cells(sLinha, 41).Value = TextBox41.Text
End With
Case "Editar"
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
With Sheets(iPlanilha)
'Atualiza os dados na linha de registro específica
.Cells(sLinha, 1).Value = TextBox1.Text
.Cells(sLinha, 2).Value = TextBox2.Text
.Cells(sLinha, 3).Value = TextBox3.Text
.Cells(sLinha, 4).Value = TextBox4.Text
.Cells(sLinha, 5).Value = TextBox5.Text
.Cells(sLinha, 6).Value = TextBox6.Text
.Cells(sLinha, 7).Value = TextBox7.Text
.Cells(sLinha, 8).Value = TextBox8.Text
.Cells(sLinha, 9).Value = TextBox9.Text
.Cells(sLinha, 10).Value = TextBox10.Text
.Cells(sLinha, 11).Value = TextBox11.Text
.Cells(sLinha, 12).Value = TextBox12.Text
.Cells(sLinha, 16).Value = TextBox16.Text
.Cells(sLinha, 18).Value = TextBox18.Text
.Cells(sLinha, 34).Value = TextBox34.Text
.Cells(sLinha, 35).Value = TextBox35.Text
.Cells(sLinha, 36).Value = TextBox36.Text
.Cells(sLinha, 37).Value = TextBox37.Text
.Cells(sLinha, 38).Value = TextBox38.Text
.Cells(sLinha, 39).Value = TextBox39.Text
.Cells(sLinha, 40).Value = TextBox40.Text
.Cells(sLinha, 41).Value = TextBox41.Text
End With
Case Else
Exit Sub
End Select
'Definir a ação do comando
sAcaoRequerida = ""
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(False)
'Recarrega os valores da pesquisa para exibir no formulário
If sCriterioDaBusca <> "" Then
txt_Procurar.Text = sCriterioDaBusca
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
'Salva o arquivo
ThisWorkbook.Save
End Sub
Private Sub SpinButton1_Change()
Dim sLinha As Long
Dim iPlanilha As Integer
Dim TotalOcorrencias As Long
If IsArray(MatrizResultadosLinha) Then 'Verifica se há informações de busca na matriz de resultados
'Se houver dados retornados da busca, então carrega no formulário
TotalOcorrencias = SpinButton1.Max + 1
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
With Sheets(iPlanilha)
Label_PlanBase.Caption = "Em " & .Name
TextBox1.Text = .Cells(sLinha, 1).Value
TextBox2.Text = .Cells(sLinha, 2).Value
TextBox3.Text = .Cells(sLinha, 3).Text
TextBox4.Text = .Cells(sLinha, 4).Value
TextBox5.Text = .Cells(sLinha, 5).Value
TextBox6.Text = .Cells(sLinha, 6).Value
TextBox7.Text = .Cells(sLinha, 7).Value
TextBox8.Text = .Cells(sLinha, 8).Value
TextBox9.Text = .Cells(sLinha, 9).Value
TextBox10.Text = .Cells(sLinha, 10).Text
TextBox11.Text = .Cells(sLinha, 11).Text
TextBox12.Text = .Cells(sLinha, 12).Text
TextBox16.Text = .Cells(sLinha, 16).Text
TextBox18.Text = .Cells(sLinha, 18).Text
TextBox34.Text = .Cells(sLinha, 34).Text
TextBox35.Text = .Cells(sLinha, 35).Text
TextBox36.Text = .Cells(sLinha, 36).Text
TextBox37.Text = .Cells(sLinha, 37).Text
TextBox38.Text = .Cells(sLinha, 38).Text
TextBox39.Text = .Cells(sLinha, 39).Text
TextBox40.Text = .Cells(sLinha, 40).Text
TextBox41.Text = .Cells(sLinha, 41).Text
End With
End If
End Sub
Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String, ByVal sPesquisarNoCampo As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim ResultadosLinha As String
Dim ResultadosPlanilha As String
Dim sSearchInCol As String
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
'Define a Coluna onde a informação será pesquisada
sSearchInCol = ConfigColunas(sPesquisarNoCampo)
'Define as Planilhas onde a informação será pesquisada
arrPesquisarNasPlanilhas = ConfigPlanilhasBase
'Inicializa os resultados
ResultadosLinha = ""
ResultadosPlanilha = ""
MatrizResultadosLinha = ""
MatrizResultadosPlanilha = ""
'Executa a busca
For i = 0 To UBound(arrPesquisarNasPlanilhas)
With Sheets(arrPesquisarNasPlanilhas(i))
If sSearchInCol = "" Then
Set Busca = .Cells.Find(What:=TermoPesquisado, After:=.Range("A4"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).Find( _
What:=TermoPesquisado, _
After:=.Range(sSearchInCol & "1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
'Caso tenha encontrado alguma ocorrência...
If Not Busca Is Nothing Then
Primeira_Ocorrencia = Busca.Address
ResultadosLinha = ResultadosLinha & IIf((Len(ResultadosLinha) > 0), ";", "") & Busca.Row 'Lista o primeiro resultado na variavel - linha da ocorrência
ResultadosPlanilha = ResultadosPlanilha & IIf((Len(ResultadosPlanilha) > 0), ";", "") & .Index 'Lista o primeiro resultado na variavel - planilha da ocorrência
'Neste loop, pesquisa todas as próximas ocorrências para
'o termo pesquisado
Do
If sSearchInCol = "" Then
Set Busca = .Cells.FindNext(After:=Busca)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).FindNext(After:=Busca)
End If
'Condicional para não listar o primeiro resultado
'pois já foi listado acima
If Not Busca.Address Like Primeira_Ocorrencia Then
ResultadosLinha = ResultadosLinha & ";" & Busca.Row
ResultadosPlanilha = ResultadosPlanilha & ";" & .Index
End If
Loop Until Busca.Address Like Primeira_Ocorrencia
End If
End With
Next i
If Len(ResultadosLinha) > 0 Then 'Se foram encontrados resultados
MatrizResultadosLinha = Split(ResultadosLinha, ";")
MatrizResultadosPlanilha = Split(ResultadosPlanilha, ";")
'Atualiza dados iniciais no formulário
SpinButton1.Max = UBound(MatrizResultadosLinha) 'Valor maximo do seletor de registros
'habilita o seletor de registro
SpinButton1.Enabled = True
'indicador do seletor de registros
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultadosLinha) + 1
'Box com o conteudo encontrado
With Sheets(CInt(MatrizResultadosPlanilha(0)))
Label_PlanBase.Caption = "Em " & .Name
TextBox1.Text = .Cells(MatrizResultadosLinha(0), 1).Value
TextBox2.Text = .Cells(MatrizResultadosLinha(0), 2).Value
TextBox3.Text = .Cells(MatrizResultadosLinha(0), 3).Text
TextBox4.Text = .Cells(MatrizResultadosLinha(0), 4).Value
TextBox5.Text = .Cells(MatrizResultadosLinha(0), 5).Value
TextBox6.Text = .Cells(MatrizResultadosLinha(0), 6).Value
TextBox7.Text = .Cells(MatrizResultadosLinha(0), 7).Value
TextBox8.Text = .Cells(MatrizResultadosLinha(0), 8).Value
TextBox9.Text = .Cells(MatrizResultadosLinha(0), 9).Value
TextBox10.Text = .Cells(MatrizResultadosLinha(0), 10).Text
TextBox11.Text = .Cells(MatrizResultadosLinha(0), 11).Text
TextBox12.Text = .Cells(MatrizResultadosLinha(0), 12).Text
TextBox16.Text = .Cells(MatrizResultadosLinha(0), 16).Text
TextBox18.Text = .Cells(MatrizResultadosLinha(0), 18).Text
TextBox34.Text = .Cells(MatrizResultadosLinha(0), 34).Text
TextBox35.Text = .Cells(MatrizResultadosLinha(0), 35).Text
TextBox36.Text = .Cells(MatrizResultadosLinha(0), 36).Text
TextBox37.Text = .Cells(MatrizResultadosLinha(0), 37).Text
TextBox38.Text = .Cells(MatrizResultadosLinha(0), 38).Text
TextBox39.Text = .Cells(MatrizResultadosLinha(0), 39).Text
TextBox40.Text = .Cells(MatrizResultadosLinha(0), 40).Text
TextBox41.Text = .Cells(MatrizResultadosLinha(0), 41).Text
End With
btn_Editar.Enabled = True
btn_Excluir.Enabled = True
Else 'Caso nada tenha sido encontrado, exibe mensagem informativa
SpinButton1.Enabled = False 'desabilita o seletor de registros
btn_Editar.Enabled = False
btn_Excluir.Enabled = False
Label_Registros_Contador.Caption = "" 'zera os resultados encontrados
Label_PlanBase.Caption = ""
'limpa os campos do formulário
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox16.Text = ""
TextBox18.Text = ""
TextBox34.Text = ""
TextBox35.Text = ""
TextBox36.Text = ""
TextBox37.Text = ""
TextBox38.Text = ""
TextBox39.Text = ""
TextBox40.Text = ""
TextBox41.Text = ""
MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."
End If
End Sub
Private Sub TextBox11_Change()
End Sub
Private Sub TextBox40_Change()
End Sub
Private Sub UserForm_Initialize()
SpinButton1.Enabled = False
btn_Editar.Enabled = False
btn_Excluir.Enabled = False
Combo_OndeSalvar.Visible = False
Label_OndeSalvar.Visible = False
Label_Registros_Contador.Caption = ""
Call ConfigurarListaDeCampos
End Sub
Sub ConfigurarListaDeCampos()
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
With ComboBox1
.Style = fmStyleDropDownList
.AddItem "Tudo" '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
.AddItem "Nota"
.AddItem "Fabricante"
.AddItem "Pedido"
.AddItem "Produto"
.AddItem "Destino Final"
.ListIndex = 0
End With
With Combo_OndeSalvar
'Recupera as Planilhas que são base de dados
arrPesquisarNasPlanilhas = ConfigPlanilhasBase
.Style = fmStyleDropDownList
For i = 0 To UBound(arrPesquisarNasPlanilhas)
.AddItem arrPesquisarNasPlanilhas(i)
Next i
.ListIndex = 0
End With
End Sub
Function ConfigColunas(ByVal sNomeCampo As String) As String
Select Case sNomeCampo
Case "Nota"
ConfigColunas = "A"
Case "Fabricante"
ConfigColunas = "D"
Case "Pedido"
ConfigColunas = "G"
Case "Produto"
ConfigColunas = "I"
Case "Destino Final"
ConfigColunas = "F"
Case Else '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
ConfigColunas = ""
End Select
End Function
Function ConfigPlanilhasBase() As Variant
Dim sNomeDasPlanilhas As String
'Digite o nome das Planilhasonde os dados deverão ser procurados,
'separados por ponto-e-vírgula (;)
'
sNomeDasPlanilhas = "Agendamentos" '<----- Informe as planilhas aqui
Do While (Right(sNomeDasPlanilhas, 1) = ";")
sNomeDasPlanilhas = Left(sNomeDasPlanilhas, Len(sNomeDasPlanilhas) - 1)
Loop
ConfigPlanilhasBase = Split(sNomeDasPlanilhas, ";")
End Function
Sub HabilitarControlesParaEdicao(ByVal bOpcao As Boolean)
'Habilitar Botões Salvar/Cancelar
btn_Salvar.Visible = bOpcao
btn_Cancelar.Visible = bOpcao
btn_Adicionar.Visible = Not (bOpcao)
btn_Editar.Visible = Not (bOpcao)
btn_Excluir.Visible = Not (bOpcao)
btn_Procurar.Enabled = Not (bOpcao)
txt_Procurar.Enabled = Not (bOpcao)
ComboBox1.Enabled = Not (bOpcao)
txt_Procurar.Value = ""
Label_Registros_Contador.Caption = ""
Label_PlanBase.Caption = ""
If bOpcao = False And IsArray(MatrizResultadosLinha) Then
SpinButton1.Enabled = True
Else
SpinButton1.Enabled = False
End If
'Liberar Campos para Edição.
TextBox1.Locked = Not (bOpcao)
TextBox2.Locked = Not (bOpcao)
TextBox3.Locked = Not (bOpcao)
TextBox4.Locked = Not (bOpcao)
TextBox5.Locked = Not (bOpcao)
TextBox6.Locked = Not (bOpcao)
'Limpar o conteúdo dos campos
If sAcaoRequerida <> "Editar" Then
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
Combo_OndeSalvar.Visible = bOpcao
Label_OndeSalvar.Visible = bOpcao
End If
If bOpcao = True Then
TextBox1.SetFocus
End If
End Sub
Como sempre falta alguma coisa;
Tentei que o textbox na consulta me retorna-se a cor de preenchimento da celula com este codigo porem não deu certo sabes me dizer onde estou errando ?
With Me.TextBox3
.Value = Format(WorksheetFunction.Text(Plan1.Cells(linha, 3).Value 'retorna o valor da celula
.BackColor = Plan1.Cells(linha, 3).Interior.Color 'Retorna a cor de preenchimeto da celula
.ForeColor = Plan1.Cells(linha, 3).Font.Color 'Retorna a Cor da fonte da celula
End With
O codigo original e este, tentei anexar a planilha para facilitar não consegui devido o tamanho da mesma.
Public MatrizResultadosLinha As Variant
Public MatrizResultadosPlanilha As Variant
Public Total_Ocorrencias As Long
Public sCriterioDaBusca As String
Public sAcaoRequerida As String
Private Sub btn_Adicionar_Click()
'Definir a ação do comando
sAcaoRequerida = "Adicionar"
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(True)
End Sub
Private Sub btn_Cancelar_Click()
'Definir a ação do comando
sAcaoRequerida = ""
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(False)
'Recarrega os controles com os valores ativos na memória
Call SpinButton1_Change
txt_Procurar.Text = sCriterioDaBusca
End Sub
Private Sub btn_Editar_Click()
'Definir a ação do comando
sAcaoRequerida = "Editar"
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(True)
End Sub
Private Sub btn_Excluir_Click()
Dim sLinha As Long
Dim iPlanilha As Integer
If MsgBox("Tem certeza que deseja eliminar este cadastro do sistema?", vbDefaultButton2 + vbQuestion + vbYesNo, Me.Caption) = vbYes Then
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
'Exclui a linha do registro
Sheets(iPlanilha).Rows(sLinha).Delete
'Salva o arquivo
ThisWorkbook.Save
'Recarrega os registros para o formulário
txt_Procurar.Text = sCriterioDaBusca
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
End Sub
Private Sub btn_Procurar_Click()
If txt_Procurar.Text = "" Then
MsgBox "Digite um valor para a pesquisa"
Else
sCriterioDaBusca = txt_Procurar.Text
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
End Sub
Private Sub btn_Salvar_Click()
Dim sLinha As Long
Dim iPlanilha As Integer
'Realiza a ação apropriada
Select Case sAcaoRequerida
Case "Adicionar"
With Sheets(Combo_OndeSalvar.Text)
sLinha = .Range("A:A").SpecialCells(xlLastCell).Row + 1 'Pega a próxima linha vazia para cadastrar novo
'Grava os novos valores informados no formulário para a planilha base de dados
.Cells(sLinha, 1).Value = TextBox1.Text
.Cells(sLinha, 2).Value = TextBox2.Text
.Cells(sLinha, 3).Value = TextBox3.Text
.Cells(sLinha, 4).Value = TextBox4.Text
.Cells(sLinha, 5).Value = TextBox5.Text
.Cells(sLinha, 6).Value = TextBox6.Text
.Cells(sLinha, 7).Value = TextBox7.Text
.Cells(sLinha, 8).Value = TextBox8.Text
.Cells(sLinha, 9).Value = TextBox9.Text
.Cells(sLinha, 10).Value = TextBox10.Text
.Cells(sLinha, 11).Value = TextBox11.Text
.Cells(sLinha, 12).Value = TextBox12.Text
.Cells(sLinha, 16).Value = TextBox16.Text
.Cells(sLinha, 18).Value = TextBox18.Text
.Cells(sLinha, 34).Value = TextBox34.Text
.Cells(sLinha, 35).Value = TextBox35.Text
.Cells(sLinha, 36).Value = TextBox36.Text
.Cells(sLinha, 37).Value = TextBox37.Text
.Cells(sLinha, 38).Value = TextBox38.Text
.Cells(sLinha, 39).Value = TextBox39.Text
.Cells(sLinha, 40).Value = TextBox40.Text
.Cells(sLinha, 41).Value = TextBox41.Text
End With
Case "Editar"
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
With Sheets(iPlanilha)
'Atualiza os dados na linha de registro específica
.Cells(sLinha, 1).Value = TextBox1.Text
.Cells(sLinha, 2).Value = TextBox2.Text
.Cells(sLinha, 3).Value = TextBox3.Text
.Cells(sLinha, 4).Value = TextBox4.Text
.Cells(sLinha, 5).Value = TextBox5.Text
.Cells(sLinha, 6).Value = TextBox6.Text
.Cells(sLinha, 7).Value = TextBox7.Text
.Cells(sLinha, 8).Value = TextBox8.Text
.Cells(sLinha, 9).Value = TextBox9.Text
.Cells(sLinha, 10).Value = TextBox10.Text
.Cells(sLinha, 11).Value = TextBox11.Text
.Cells(sLinha, 12).Value = TextBox12.Text
.Cells(sLinha, 16).Value = TextBox16.Text
.Cells(sLinha, 18).Value = TextBox18.Text
.Cells(sLinha, 34).Value = TextBox34.Text
.Cells(sLinha, 35).Value = TextBox35.Text
.Cells(sLinha, 36).Value = TextBox36.Text
.Cells(sLinha, 37).Value = TextBox37.Text
.Cells(sLinha, 38).Value = TextBox38.Text
.Cells(sLinha, 39).Value = TextBox39.Text
.Cells(sLinha, 40).Value = TextBox40.Text
.Cells(sLinha, 41).Value = TextBox41.Text
End With
Case Else
Exit Sub
End Select
'Definir a ação do comando
sAcaoRequerida = ""
'Habilitar Botões Salvar/Cancelar
Call HabilitarControlesParaEdicao(False)
'Recarrega os valores da pesquisa para exibir no formulário
If sCriterioDaBusca <> "" Then
txt_Procurar.Text = sCriterioDaBusca
Call ProcuraPersonalizada(sCriterioDaBusca, ComboBox1.Text)
End If
'Salva o arquivo
ThisWorkbook.Save
End Sub
Private Sub SpinButton1_Change()
Dim sLinha As Long
Dim iPlanilha As Integer
Dim TotalOcorrencias As Long
If IsArray(MatrizResultadosLinha) Then 'Verifica se há informações de busca na matriz de resultados
'Se houver dados retornados da busca, então carrega no formulário
TotalOcorrencias = SpinButton1.Max + 1
sLinha = MatrizResultadosLinha(SpinButton1.Value)
iPlanilha = MatrizResultadosPlanilha(SpinButton1.Value)
Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias
With Sheets(iPlanilha)
Label_PlanBase.Caption = "Em " & .Name
TextBox1.Text = .Cells(sLinha, 1).Value
TextBox2.Text = .Cells(sLinha, 2).Value
TextBox3.Text = .Cells(sLinha, 3).Text
TextBox4.Text = .Cells(sLinha, 4).Value
TextBox5.Text = .Cells(sLinha, 5).Value
TextBox6.Text = .Cells(sLinha, 6).Value
TextBox7.Text = .Cells(sLinha, 7).Value
TextBox8.Text = .Cells(sLinha, 8).Value
TextBox9.Text = .Cells(sLinha, 9).Value
TextBox10.Text = .Cells(sLinha, 10).Text
TextBox11.Text = .Cells(sLinha, 11).Text
TextBox12.Text = .Cells(sLinha, 12).Text
TextBox16.Text = .Cells(sLinha, 16).Text
TextBox18.Text = .Cells(sLinha, 18).Text
TextBox34.Text = .Cells(sLinha, 34).Text
TextBox35.Text = .Cells(sLinha, 35).Text
TextBox36.Text = .Cells(sLinha, 36).Text
TextBox37.Text = .Cells(sLinha, 37).Text
TextBox38.Text = .Cells(sLinha, 38).Text
TextBox39.Text = .Cells(sLinha, 39).Text
TextBox40.Text = .Cells(sLinha, 40).Text
TextBox41.Text = .Cells(sLinha, 41).Text
End With
End If
End Sub
Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String, ByVal sPesquisarNoCampo As String)
Dim Busca As Range
Dim Primeira_Ocorrencia As String
Dim ResultadosLinha As String
Dim ResultadosPlanilha As String
Dim sSearchInCol As String
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
'Define a Coluna onde a informação será pesquisada
sSearchInCol = ConfigColunas(sPesquisarNoCampo)
'Define as Planilhas onde a informação será pesquisada
arrPesquisarNasPlanilhas = ConfigPlanilhasBase
'Inicializa os resultados
ResultadosLinha = ""
ResultadosPlanilha = ""
MatrizResultadosLinha = ""
MatrizResultadosPlanilha = ""
'Executa a busca
For i = 0 To UBound(arrPesquisarNasPlanilhas)
With Sheets(arrPesquisarNasPlanilhas(i))
If sSearchInCol = "" Then
Set Busca = .Cells.Find(What:=TermoPesquisado, After:=.Range("A4"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).Find( _
What:=TermoPesquisado, _
After:=.Range(sSearchInCol & "1"), _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
End If
'Caso tenha encontrado alguma ocorrência...
If Not Busca Is Nothing Then
Primeira_Ocorrencia = Busca.Address
ResultadosLinha = ResultadosLinha & IIf((Len(ResultadosLinha) > 0), ";", "") & Busca.Row 'Lista o primeiro resultado na variavel - linha da ocorrência
ResultadosPlanilha = ResultadosPlanilha & IIf((Len(ResultadosPlanilha) > 0), ";", "") & .Index 'Lista o primeiro resultado na variavel - planilha da ocorrência
'Neste loop, pesquisa todas as próximas ocorrências para
'o termo pesquisado
Do
If sSearchInCol = "" Then
Set Busca = .Cells.FindNext(After:=Busca)
Else
Set Busca = .Range(sSearchInCol & ":" & sSearchInCol).FindNext(After:=Busca)
End If
'Condicional para não listar o primeiro resultado
'pois já foi listado acima
If Not Busca.Address Like Primeira_Ocorrencia Then
ResultadosLinha = ResultadosLinha & ";" & Busca.Row
ResultadosPlanilha = ResultadosPlanilha & ";" & .Index
End If
Loop Until Busca.Address Like Primeira_Ocorrencia
End If
End With
Next i
If Len(ResultadosLinha) > 0 Then 'Se foram encontrados resultados
MatrizResultadosLinha = Split(ResultadosLinha, ";")
MatrizResultadosPlanilha = Split(ResultadosPlanilha, ";")
'Atualiza dados iniciais no formulário
SpinButton1.Max = UBound(MatrizResultadosLinha) 'Valor maximo do seletor de registros
'habilita o seletor de registro
SpinButton1.Enabled = True
'indicador do seletor de registros
Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultadosLinha) + 1
'Box com o conteudo encontrado
With Sheets(CInt(MatrizResultadosPlanilha(0)))
Label_PlanBase.Caption = "Em " & .Name
TextBox1.Text = .Cells(MatrizResultadosLinha(0), 1).Value
TextBox2.Text = .Cells(MatrizResultadosLinha(0), 2).Value
TextBox3.Text = .Cells(MatrizResultadosLinha(0), 3).Text
TextBox4.Text = .Cells(MatrizResultadosLinha(0), 4).Value
TextBox5.Text = .Cells(MatrizResultadosLinha(0), 5).Value
TextBox6.Text = .Cells(MatrizResultadosLinha(0), 6).Value
TextBox7.Text = .Cells(MatrizResultadosLinha(0), 7).Value
TextBox8.Text = .Cells(MatrizResultadosLinha(0), 8).Value
TextBox9.Text = .Cells(MatrizResultadosLinha(0), 9).Value
TextBox10.Text = .Cells(MatrizResultadosLinha(0), 10).Text
TextBox11.Text = .Cells(MatrizResultadosLinha(0), 11).Text
TextBox12.Text = .Cells(MatrizResultadosLinha(0), 12).Text
TextBox16.Text = .Cells(MatrizResultadosLinha(0), 16).Text
TextBox18.Text = .Cells(MatrizResultadosLinha(0), 18).Text
TextBox34.Text = .Cells(MatrizResultadosLinha(0), 34).Text
TextBox35.Text = .Cells(MatrizResultadosLinha(0), 35).Text
TextBox36.Text = .Cells(MatrizResultadosLinha(0), 36).Text
TextBox37.Text = .Cells(MatrizResultadosLinha(0), 37).Text
TextBox38.Text = .Cells(MatrizResultadosLinha(0), 38).Text
TextBox39.Text = .Cells(MatrizResultadosLinha(0), 39).Text
TextBox40.Text = .Cells(MatrizResultadosLinha(0), 40).Text
TextBox41.Text = .Cells(MatrizResultadosLinha(0), 41).Text
End With
btn_Editar.Enabled = True
btn_Excluir.Enabled = True
Else 'Caso nada tenha sido encontrado, exibe mensagem informativa
SpinButton1.Enabled = False 'desabilita o seletor de registros
btn_Editar.Enabled = False
btn_Excluir.Enabled = False
Label_Registros_Contador.Caption = "" 'zera os resultados encontrados
Label_PlanBase.Caption = ""
'limpa os campos do formulário
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
TextBox9.Text = ""
TextBox10.Text = ""
TextBox11.Text = ""
TextBox12.Text = ""
TextBox16.Text = ""
TextBox18.Text = ""
TextBox34.Text = ""
TextBox35.Text = ""
TextBox36.Text = ""
TextBox37.Text = ""
TextBox38.Text = ""
TextBox39.Text = ""
TextBox40.Text = ""
TextBox41.Text = ""
MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."
End If
End Sub
Private Sub TextBox11_Change()
End Sub
Private Sub TextBox40_Change()
End Sub
Private Sub UserForm_Initialize()
SpinButton1.Enabled = False
btn_Editar.Enabled = False
btn_Excluir.Enabled = False
Combo_OndeSalvar.Visible = False
Label_OndeSalvar.Visible = False
Label_Registros_Contador.Caption = ""
Call ConfigurarListaDeCampos
End Sub
Sub ConfigurarListaDeCampos()
Dim arrPesquisarNasPlanilhas As Variant
Dim i As Integer
With ComboBox1
.Style = fmStyleDropDownList
.AddItem "Tudo" '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
.AddItem "Nota"
.AddItem "Fabricante"
.AddItem "Pedido"
.AddItem "Produto"
.AddItem "Destino Final"
.ListIndex = 0
End With
With Combo_OndeSalvar
'Recupera as Planilhas que são base de dados
arrPesquisarNasPlanilhas = ConfigPlanilhasBase
.Style = fmStyleDropDownList
For i = 0 To UBound(arrPesquisarNasPlanilhas)
.AddItem arrPesquisarNasPlanilhas(i)
Next i
.ListIndex = 0
End With
End Sub
Function ConfigColunas(ByVal sNomeCampo As String) As String
Select Case sNomeCampo
Case "Nota"
ConfigColunas = "A"
Case "Fabricante"
ConfigColunas = "D"
Case "Pedido"
ConfigColunas = "G"
Case "Produto"
ConfigColunas = "I"
Case "Destino Final"
ConfigColunas = "F"
Case Else '<--- Esta é utilizada para definir quando pesquisar em toda a planilha
ConfigColunas = ""
End Select
End Function
Function ConfigPlanilhasBase() As Variant
Dim sNomeDasPlanilhas As String
'Digite o nome das Planilhasonde os dados deverão ser procurados,
'separados por ponto-e-vírgula (;)
'
sNomeDasPlanilhas = "Agendamentos" '<----- Informe as planilhas aqui
Do While (Right(sNomeDasPlanilhas, 1) = ";")
sNomeDasPlanilhas = Left(sNomeDasPlanilhas, Len(sNomeDasPlanilhas) - 1)
Loop
ConfigPlanilhasBase = Split(sNomeDasPlanilhas, ";")
End Function
Sub HabilitarControlesParaEdicao(ByVal bOpcao As Boolean)
'Habilitar Botões Salvar/Cancelar
btn_Salvar.Visible = bOpcao
btn_Cancelar.Visible = bOpcao
btn_Adicionar.Visible = Not (bOpcao)
btn_Editar.Visible = Not (bOpcao)
btn_Excluir.Visible = Not (bOpcao)
btn_Procurar.Enabled = Not (bOpcao)
txt_Procurar.Enabled = Not (bOpcao)
ComboBox1.Enabled = Not (bOpcao)
txt_Procurar.Value = ""
Label_Registros_Contador.Caption = ""
Label_PlanBase.Caption = ""
If bOpcao = False And IsArray(MatrizResultadosLinha) Then
SpinButton1.Enabled = True
Else
SpinButton1.Enabled = False
End If
'Liberar Campos para Edição.
TextBox1.Locked = Not (bOpcao)
TextBox2.Locked = Not (bOpcao)
TextBox3.Locked = Not (bOpcao)
TextBox4.Locked = Not (bOpcao)
TextBox5.Locked = Not (bOpcao)
TextBox6.Locked = Not (bOpcao)
'Limpar o conteúdo dos campos
If sAcaoRequerida <> "Editar" Then
TextBox1.Value = ""
TextBox2.Value = ""
TextBox3.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
Combo_OndeSalvar.Visible = bOpcao
Label_OndeSalvar.Visible = bOpcao
End If
If bOpcao = True Then
TextBox1.SetFocus
End If
End Sub