Search for text in rectangles
Hi Bakuryu,
Give this code a try:
Dim FindTxtSave As String 'Last rectangle search text
Sub FindRecText()
FindRectangleText
End Sub
Sub FindRectangleText(Optional FindTxt As String = "")
'Searches all rectangles on the active sheet for text
Dim Sh As Shape
Dim iCh As Integer
Dim lCh As Integer
Dim answer As Variant
Dim FillSet As Boolean
If FindTxt = "" Then
FindTxt = InputBox("Enter find text", "Rectangle Text Search")
End If
If FindTxt = "" Then Exit Sub
lCh = Len(FindTxt)
For Each Sh In ActiveSheet.Shapes
If Sh.Type = msoTextBox Then
iCh = 1
FillSet = False
Do While True
iCh = InStr(iCh, Sh.TextFrame.Characters.Text, FindTxt)
If iCh = 0 Then Exit Do
If Not FillSet Then
Sh.Fill.ForeColor.RGB = NotRGB(Sh.Fill.ForeColor.RGB)
FillSet = True
End If
Beep
'highlight characters
With Sh.TextFrame.Characters(iCh, lCh)
.Font.Color = NotC(.Font.Color)
End With
iCh = iCh + 1
Loop
End If
Next Sh
FindTxtSave = FindTxt
End Sub
Sub ClearFind()
FindRectangleText FindTxtSave
End Sub
Function NotC(Cin As Variant) As Long
'Invert colorindex color and convert to RGB
If Cin = 0 Or Cin = Null Then
NotC = &HFFFFFF
Else
NotC = Not ActiveWorkbook.Colors(Cin)
NotC = NotC And &HFFFFFF
End If
End Function
Function NotRGB(Cin As Long) As Long
'Invert RGB color
NotRGB = Not Cin
NotRGB = NotRGB And &HFFFFFF
End Function
This code should be placed in a standard macro module. To do this, go to the VBE (keyboard Alt-TMV), insert a new macro module (Alt-IM), and paste this code into the Code pane.
The approach I used was to highlight all the text found. To do the find, run macro FindRecText. It will prompt you for the text you want to search for and will highlight the found text by reversing the color of the text--and to make sure it is visible it also reverses the fill color of the rectangles. Obviously, reversing black text to white in a rectangle containing white fill would make the text invisible--not a very effective way to highlight it. But reversing both text and fill ensures the found text is visible, even though it might make the other text invisible.
To un-highlight the previously found text, run the macro ClearFind.
I hope this does what you want.
Damon