テキストボックス内のテキストの検索（Microsoft Excel）

Sub FindInShape1()

Dim rStart As Range     Dim shp As Shape     Dim sFind As String     Dim sTemp As String     Dim Response

sFind = InputBox("Search for?")

If Trim(sFind) = "" Then         MsgBox "Nothing entered"

Exit Sub     End If     Set rStart = ActiveCell     For Each shp In ActiveSheet.Shapes         sTemp = shp.TextFrame2.TextRange.Characters.Text         If InStr(LCase(sTemp), LCase(sFind)) <> 0 Then             shp.Select             Response = MsgBox( _               prompt:=shp.Name & vbCrLf & _               sTemp & vbCrLf & vbCrLf & _               "Do you want to continue?", _               Buttons:=vbYesNo, Title:="Continue?")

If Response <> vbYes Then                 Set rStart = Nothing                 Exit Sub             End If         End If     Next     MsgBox "No more found"

rStart.Select     Set rStart = Nothing End Sub

Sub FindInShape2()

Dim shp As Shape     Dim sFind As String     Dim sTemp As String     Dim iPos As Integer     Dim Response

sFind = InputBox("Search for?")

If Trim(sFind) = "" Then         MsgBox "Nothing entered"

Exit Sub     End If     sFind = LCase(sFind)

For Each shp In ActiveSheet.Shapes         sTemp = LCase(shp.TextFrame2.TextRange.Characters.Text)

iPos = InStr(sTemp, sFind)

If iPos > 0 Then             With shp.TextFrame2.TextRange.Characters(Start:=iPos, _               Length:=Len(sFind)).Font                 .UnderlineStyle = msoUnderlineHeavyLine                 .Bold = True             End With         End If     Next     MsgBox "Finished"

End Sub

Sub ResetFont()

Dim shp As Shape

For Each shp In ActiveSheet.Shapes         With shp.TextFrame2.TextRange.Characters.Font             .UnderlineStyle = msoNoUnderline             .Bold = False         End With     Next End Sub