VBA 図形内テキストを一括で検索・置換する方法
VBAで図形内テキストを一括で検索・置換する方法です。
Excelの検索対象はセル内のみとなっており、図形内のテキストは検索対象外となっています。そのため、図形内の文字は人の目で探す・書き換えるということをしないといけません。めんどくさがりな筆者は2回以上の同じ作業はやりたくありません。
そこで以前「Excel 図形内のテキストを検索・置換する方法」という記事を書いて「RelaxTools Addin」を利用する方法を紹介しました。
こんな便利なツールがあるんだから、無理して自前でVBAを書くこともないんだけど、そこはやっぱりエンジニアとしてやってみたくなるじゃないですか。
しかも、これがなかなか奥深い。単純置換では複数図形は処理できないし、グループ化された図形も処理できなかった。
ここでは VBAで図形内テキストを一括で検索・置換する方法 を紹介します。
Sponsored Links
マクロの仕様
図形内テキストを検索・置換するマクロの仕様はこんな感じです。
- 検索用入力ダイアログを表示して検索する文字を入力する。
- 置換用入力ダイアログを表示して置換する文字を入力する。
- シート内のすべての図形内テキストにある置換対象文字を置換文字に置き換える。
- グループ化されている図形も対象とする。
Sponsored Links
サンプルプログラム
下記を標準モジュールへ貼り付けてください。
Option Explicit Private ReplaceCount As Long ' 置換件数 ' ' 関数名:図形内文字列の検索と置換 ' 引数 :なし ' 戻り値:なし ' Public Sub SearchAndReplaceOfShapeText() Dim SearchText As String ' 検索する文字列 Dim ReplaceText As String ' 置換後の文字 ' 検索文字列入力用InputBoxを表示 SearchText = InputBox("検索する文字列") ' 検索文字列の入力がなければ処理終了 If SearchText = "" Then Exit Sub End If ' 置換文字列入力用InputBoxを表示 If ReplaceText = "" Then ReplaceText = InputBox("置換後の文字列") End If ' 置換処理 ReplaceCount = 0 If ReplaceOfShapeText(ActiveSheet.Shapes, SearchText, ReplaceText) Then MsgBox ReplaceCount & " 件を置換しました。", vbInformation Else MsgBox "置換対象が見つかりません。", vbExclamation End If End Sub ' ' 関数名:図形文字列の置換 ' 引数1:Shapes 図形オブジェクト ' 引数2:SearchText 検索文字列 ' 引数3:ReplaceText 置換文字列 ' 戻り値:True:置換成功、False:置換対象なし ' Private Function ReplaceOfShapeText(ByRef Shapes As Object, ByRef SearchText As String, ByRef ReplaceText As String) As Boolean Dim Ret As Boolean ' 処理結果 Dim Shape As Shape ' 図形オブジェクト Dim ShapeText As String ' 図形内の文字列 Dim Pos As Long ' 文字列位置 ' 初期値設定 Ret = False ' シート内の図形を検索 For Each Shape In Shapes ' グループ化された図形の場合 If Shape.Type = msoGroup Then ' 再帰呼び出し If ReplaceOfShapeText(Shape.GroupItems, SearchText, ReplaceText) Then Ret = True ReplaceCount = ReplaceCount + 1 Exit For End If ' テキストフレームに文字列がある場合 ElseIf Shape.TextFrame2.HasText = msoTrue Then ' 図形内の文字列を置換 Do While (1) ' 図形内の文字列を取得 ShapeText = Shape.TextFrame2.TextRange.text ' 図形内の文字列から検索文字列位置を取得 Pos = InStr(ShapeText, SearchText) ' 検索文字列が見つからない場合は処理終了 If Pos = 0& Then Exit Do End If ' 検索文字列を置換する Shape.TextFrame2.TextRange.text = Replace(ShapeText, SearchText, ReplaceText) Ret = True ReplaceCount = ReplaceCount + 1 Loop End If Next ' 処理結果を返す ReplaceOfShapeText = Ret End Function
簡単に説明すると、検索文字列入力用のインプットボックスと置換文字列入力用のインプットボックスを表示して、図形オブジェクト分ループして図形内の文字列を探して置き換えるって処理です。ポイントは、グループ化された図形は「Shape.Type = msoGroup」となるので、再帰呼び出しでグループ化された図形を引き渡しています。
動作検証
早速、動作検証してみましょう。
下図のような図形オブジェクトを配置します。1つはグループ化された図形です。
この中の「あああ」を「zzz」に変換してみましょう。
マクロを実行します。
検索する文字列は「あああ」と入力してOKします。
すると下記のメッセージが表示されます。
すると・・・・、
おおおー、図形内の文字列が置換されてるー!!
Sponsored Links
まとめ
VBAで図形内テキストを検索・置換する方法を紹介しました。
今のところ筆者の仕事の中では使うことがないのですが、どなたかのお役にたてればうれしいですね。
サンプルは こちら に置いてあります。利用は自己責任でお願いします。不具合などあればコメントください。
追記
上の方法だと、太字や文字色を変えていた場合など、フォント設定に影響が出ることがわかりました。
この原因は Shape.TextFrame2.TextRange.text
に対して置換後の文字列を上書きしているためです。なので該当部分を下記のように変更してフォント設定を維持しましょう。
' 検索文字列を置換する 'Shape.TextFrame2.TextRange.text = Replace(ShapeText, SearchText, ReplaceText ' ←これではフォント設定が維持できない。 Shape.TextFrame.Characters(Pos, Len(SearchText)).text = ReplaceText
Shape.TextFrame.Characters
は開始位置と終了位置を指定できます。これを使って該当文字列のみ上書きするという方法で対応できます。セルを編集状態にして該当文字列を選択して書き換えるというと伝わるでしょうか。
試してみると、、、
おおおー、フォント設定は維持されたまま置換できたー^^
サンプルも変更しておきましたのでご利用ください。
おつかれさまでした。
Sponsored Links