Boa tarde!
Pessoal estou prestes a deixá-los arrepiados!!!!!!.
Com o auxilio da Internet, conseguir adaptar o código para uma pesquisa personalizada.
No entanto, já tentei de diversas formas e tenho que reconhecer meus limites, pois não consigo ter um progresso...
Dúvida:
Gostaria de quando eu informar no textbox a palavra a ser pesquisada, esta ao ser localizada o Textbox viesse colorido (Ex. Amarelo).
Pela lógica então se a palavra pesquizada fosse encontrada em vários textbox eles viriam coloridos...
Será que é possível?
anexo segue exemplo da Useform sublinhada por mim...
[img]

[/img]
Se você puder me ajudar, seria muito grato.
Abaixo segue código...

Public MatrizResultados As Variant
Public Total_Ocorrencias As Long

Private Sub ProcuraPersonalizada(ByVal TermoPesquisado As String)
2   Dim Busca As Range
3   Dim Primeira_Ocorrencia As String
4   Dim Resultados As String
    
5
6   'Executa a busca
Set Busca = Plan9.Cells.Find(What:=TermoPesquisado, After:=Plan9.Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
10
11  'Caso tenha encontrado alguma ocorrência...
12  If Not Busca Is Nothing Then
13
14  Primeira_Ocorrencia = Busca.Address
15  Resultados = Busca.Row 'Lista o primeiro resultado na variavel
   

16
17  'Neste loop, pesquisa todas as próximas ocorrências para
18  'o termo pesquisado
19  Do
20  Set Busca = Plan9.Cells.FindNext(After:=Busca)
21
22  'Condicional para não listar o primeiro resultado
23  'pois já foi listado acima
24  If Not Busca.Address Like Primeira_Ocorrencia Then
25  Resultados = Resultados & ";" & Busca.Row
26  End If
27  Loop Until Busca.Address Like Primeira_Ocorrencia
28
29  MatrizResultados = Split(Resultados, ";")
30
31  'Atualiza dados iniciais no formulário
32  SpinButton1.Max = UBound(MatrizResultados) 'Valor maximo do seletor de registros
33
34  'habilita o seletor de registro
35  SpinButton1.Enabled = True
36  SpinButton1.Value = 0
37  'indicador do seletor de registros
38  Label_Registros_Contador.Caption = "1 de " & UBound(MatrizResultados) + 1
39
40  'Box com o conteudo encontrado
41  TextBox16.Text = Plan9.Cells(MatrizResultados(0), 1).Value
42  TextBox17.Text = Plan9.Cells(MatrizResultados(0), 7).Value
43  TextBox19.Text = Plan9.Cells(MatrizResultados(0), 2).Value
44  TextBox14.Text = Plan9.Cells(MatrizResultados(0), 6).Value
    TextBox18.Text = Plan9.Cells(MatrizResultados(0), 3).Value
    TextBox20.Text = Plan9.Cells(MatrizResultados(0), 4).Value
    TextBox15.Text = Plan9.Cells(MatrizResultados(0), 5).Value
    'TextBox13.Text = Plan9.Cells(MatrizResultados(0), 9).Value
    'TextBox12.Text = Plan9.Cells(MatrizResultados(0), 12).Value
    TextBox22.Text = Plan9.Cells(MatrizResultados(0), 9).Value
    TextBox21.Text = Plan9.Cells(MatrizResultados(0), 8).Value
    TextBox23.Text = Plan9.Cells(MatrizResultados(0), 10).Value
    
45
46  Else 'Caso nada tenha sido encontrado, exibe mensagem informativa
47
48  SpinButton1.Enabled = False 'desabilita o seletor de registros
49  Label_Registros_Contador.Caption = "" 'zera os resultados encontrados
50  'limpa os campos do formulário
    TextBox16.Text = ""
    TextBox17.Text = ""
    TextBox19.Text = ""
    TextBox14.Text = ""
    TextBox18.Text = ""
    TextBox20.Text = ""
    TextBox15.Text = ""
    'TextBox13.Text = ""
    'TextBox12.Text = ""
    TextBox22.Text = ""
    TextBox21.Text = ""
    TextBox23.Text = ""
    
51  MsgBox "Nenhum resultado para '" & TermoPesquisado & "' foi encontrado."
56
57  End If
58
59  End Sub

Private Sub btn_Procurar_Click()
10  If Me.txt_Procurar.Text = "" Then
11  MsgBox "Digite um valor para a pesquisa"
    
12  Else
13  Call ProcuraPersonalizada(Me.txt_Procurar.Text)
    
14  End If
15
16  End Sub



Private Sub ComboBox1_Change()

End Sub

Private Sub CommandButton1_Click()
Dim FNome As String
FNome = TextBox16
If TextBox16 = "" Then
MsgBox "Campos obrigatórios em branco, realize a pesquisa", vbInformation, "Não há item para abrir"
txt_Procurar.SetFocus

Else
ThisWorkbook.FollowHyperlink "C:Teste2013" + FNome + ".pdf"

End If
End Sub




Private Sub CommandButton2_Click()
Unload frmbusca
UserForm1.Show

End Sub

Private Sub CommandButton3_Click()
'frmbusca.Hide
'frmWait.Show
senha.Show
'Application.Visible = True
End Sub

Private Sub CommandButton7_Click()
ThisWorkbook.FollowHyperlink "http://www.coleol.com.br/"
End Sub


Private Sub CommandButton4_Click()
If frmbusca.TextBox16 = "" Then
MsgBox "Campos obrigatórios em branco, realize a pesquisa", vbInformation, "Não há itens para enviar"
frmbusca.txt_Procurar.SetFocus

Else
destinatarios.Show

'senha.Show
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 = "1 de " & UBound(MatrizResultados) + 1


  Label_Registros_Contador.Caption = SpinButton1.Value + 1 & " de " & TotalOcorrencias

  TextBox16.Text = ""
  TextBox17.Text = ""
  TextBox19.Text = ""
  TextBox14.Text = ""
  TextBox18.Text = ""
  TextBox20.Text = ""
  TextBox15.Text = ""
  'TextBox13.Text = ""
  'TextBox12.Text = ""
  TextBox22.Text = ""
  TextBox21.Text = ""
  TextBox23.Text = ""
  
  
  TextBox16.Text = Plan9.Cells(Linha, 1).Value
  TextBox17.Text = Plan9.Cells(Linha, 7).Value
  TextBox19.Text = Plan9.Cells(Linha, 2).Value
  TextBox14.Text = Plan9.Cells(Linha, 6).Value
  TextBox18.Text = Plan9.Cells(Linha, 3).Value
  TextBox20.Text = Plan9.Cells(Linha, 4).Value
  TextBox15.Text = Plan9.Cells(Linha, 5).Value
  'TextBox13.Text = Plan9.Cells(Linha, 9).Value
  'TextBox12.Text = Plan9.Cells(Linha, 12).Value
  TextBox22.Text = Plan9.Cells(Linha, 9).Value
  TextBox21.Text = Plan9.Cells(Linha, 8).Value
  TextBox23.Text = Plan9.Cells(Linha, 10).Value

  End Sub


Private Sub StatusBar2_PanelClick(ByVal Panel As MSComctlLib.Panel)

End Sub



Private Sub TextBox16_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

'Dim FNome As String
'FNome = TextBox16

Shell "Cteste1.pdf"

End Sub

Private Sub TextBox19_Change()

End Sub

Private Sub txt_Procurar_Change()

End Sub

Private Sub UserForm_Activate()
txt_Procurar.SetFocus
Dim wshNetwork As Object
Dim LogonName As Variant



Set wshNetwork = CreateObject("WScript.Network")
LogonName = "" & wshNetwork.UserName
Label23 = LogonName
Label24 = Date

'StatusBar1.Panels(1).Text = Format(Date, "DD/MM/YYYY")
'StatusBar1.Panels(1).Width = 50
'StatusBar1.Panels(1).Alignment = Center
'StatusBar2.Panels(1).Text = LogonName
'StatusBar2.Panels(1).Width = 50


End Sub

Private Sub UserForm_Initialize()
SpinButton1.Enabled = False
Label_Registros_Contador.Caption = ""

End Sub

'Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    'If CloseMode = vbFormControlMenu Then
        'Cancel = True
        'MsgBox "Favor sair do programa clicando no botão 'Fechar'" _
          ', vbCritical _
          ', "Erro - Função Desabilitada"
    'End If
'End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        Cancel = True
        MsgBox "Para sair do programa: clicar em voltar em seguida clicar no botão 'Sair'" _
          , vbCritical _
          , "Erro - Função Desabilitada"
    End If
End Sub

Atenciosamente,
Alexandre.