Notifications

Clear all

Realçar Resultado no Texbox

2024 - VBA & Macros

Post Recente por Fernando Fernandes 11 anos atrás

7 Posts

4 Usuários

0 Reactions

2,226 Visualizações

RSS

Alexcs

(@alexcs)

Posts: 7

Active Member

Topic starter

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.

Postado : 03/01/2014 12:23 pm

Wagner Morel

(@wagner-morel-vidal-nobre)

Posts: 0

Illustrious Member

Alexcs,

Boa Tarde!

Basta você adicionar a linha abaixo em seu código para que o textbox fique com a cor de fundo amarela. Essa linha, deve ser adicionada logo após a instrução que mostra o texto pesquisado (encontrado) no respectivo textbox:

    TextBox1.BackColor = &HFFFF&

Desenvolvo pequenas soluções em VBA Excel a valores que variam entre R$ 50,00 a R$ 200,00. Se te interessar, entre no meu instagran (vba_excel_desenvolvimento)

Atenciosamente
Wagner Morel

Postado : 03/01/2014 1:20 pm

Alexcs

(@alexcs)

Posts: 7

Active Member

Topic starter

Bom Dia!

Amigo,
Primeiramente obrigado pela atenção, mas não estou conseguindo, visto que o objetivo seria pintar o textbox somente com a palavra pesquisada, por favor, caso possa me ajudar, ficarei muito grato...

Postado : 06/01/2014 4:22 am

tacito

(@tacito)

Posts: 67

Trusted Member

Acho que você pode utilizar o seguinte comando no evento clique do botão "Pesquisar"

Private Sub 'Nome_do_Botão'_Click()

Dim caixa As Variant

For Each caixa In Me.Controls

    If TypeOf caixa Is MSForms.TextBox Then
    
        If InStr(1, caixa.Value, 'Nome_da_caixa_de_texto_onde_está_o_texto_a_ser _procurado'.Value, vbTextCompare) > 0 Then
        
            caixa.BackColor = &HFFFF&
            
        Else
        
            caixa.BackColor = &H80000005
            
        End If
        
    End If
    
Next

End Sub

Desse jeito a caixa onde você insere o texto a ser pesquisado também fica com o fundo amarelo, se quiser evitar isso é só trocar o trecho:

If InStr(1, caixa.Value, 'Nome_da_caixa_de_texto_onde_está_o_texto_a_ser _procurado'.Value, vbTextCompare) > 0 Then

por

If InStr(1, caixa.Value, 'Nome_da_caixa_de_texto_onde_está_o_texto_a_ser _procurado'.Value, vbTextCompare) > 0  and caixa.name <> " 'Nome_da_caixa_de_texto_onde_está_o_texto_a_ser _procurado'" Then

Postado : 06/01/2014 6:09 am

Alexcs

(@alexcs)

Posts: 7

Active Member

Topic starter

Boa Tarde!
Amigo,
Muito obrigado pela ajuda...mas por favor, me ajude mais uma vez:

Eu digito a palavra para procurar no textbox chamado (txt_Procurar) e clico no botão pesquisar. Já o resultado apareceria no textbox19.....

Obs: Qdo eu digito a palavra e pesquiso, no textbox19 aparece todo um texto, na qual, aparece a palavra...ou seja ela não aparece isola no textbox19...
...Como ficaria adaptado no seu código?

Postado : 06/01/2014 10:29 am

Alexcs

(@alexcs)

Posts: 7

Active Member

Topic starter

Bom Dia Galera!!!

Quero expressar meu interio agradecimento ao Tacito, foram inumeros e-mails trocados...é inacreditavel a seriedade do site planilhando e de toda a equipe de colaboradores.Muito obrigado Tacito pela ajuda e paciência no empenho.
O código deu certissimo, melhor impossivel.
Muito OBRIGADO.
Att,

Alexcs

Postado : 10/01/2014 5:30 am