|
>ows.Activate
>oTBox.Select
>strWk = Replace(Selection.Characters.Text, _
>strFind, strRep, 1, -1, vbTextCompare)
>If strWk = strRep Then
>oTBox.DrawingObject.Characters.Font.ColorIndex = 5 '青にする
>End If
の部分を独立させたプロシージャを作ってみました。
'#####オートシェイプ内の置換処理(置換後⇒青)をする#####
Sub ReplaceAndColorInShape(Target As Shape, strFind As String, strReplace As String)
'テキストを持たないオートシェープなら処理を終了する。
On Error GoTo TextGetError_
Dim ShapeText As String
ShapeText = Target.TextFrame.Characters.Text
On Error GoTo 0
Dim ReplaceResult As String
ReplaceResult = Replace(ShapeText, strFind, strReplace, 1, -1, vbTextCompare)
If ReplaceResult <> ShapeText Then
Target.TextFrame.Characters.Text = ReplaceResult
Target.DrawingObject.Characters.Font.ColorIndex = 5 '青にする
End If
Exit Sub
TextGetError_:
End Sub
エラー処理を加えたりしたので元のコードより長くなってしまいましたが、こうやってプロシージャとして独立させてやると以下のようなテストプロシージャを使ったりしながら、動作のおかしい部分に集中してデバッグが出来ます。
'ReplaceAndColorInShapeのテスト用プロシージャ
Sub testReplaceAndColorInShape()
Dim s As Shape
For Each s In Sheet1.Shapes
ReplaceAndColorInShape s, "検索文字列", "置換結果"
Next
End Sub
|
|