EXCELファイルに含まれるオートシェイプの文字を検索するマクロを書きました。入力ファイルと検索キーワードを指定すると、入力ファイルのオートシェイプを1つずつ調べていき、オートシェイプのテキストに検索キーワードが含まれる場合にそのテキストを出力します。
例えば上図のようなオートシェイプを含んだファイルを入力し、検索キーワードに「修正」を入力すると、「ここは修正した」「修正内容」「B処理を修正」を出力します。
サンプルマクロ
Option Explicit Sub SearchInAutoShape() ' 入力ファイル Dim inputfile As String inputfile = "C:\work\sample.xlsx" ' 検索キーワード Dim keyword As String keyword = "修正" ' ファイルオープン Application.ScreenUpdating = False Dim inputBook As Workbook Set inputBook = Workbooks.Open(inputfile, ReadOnly:=True) ' シート数分繰り返し Dim i As Long For i = 1 To inputBook.Worksheets.Count ' シートに貼り付けられているオートシェイプ分繰り返す Dim parentShape As Shape For Each parentShape In inputBook.Worksheets(i).Shapes Dim text As String ' オートシェイプがグループ化されている場合、 ' グループ化されているオートシェイプのテキストをチェック If parentShape.Type = msoGroup Then Dim groupedShape As Shape For Each groupedShape In parentShape.GroupItems text = groupedShape.TextFrame.Characters.text If InStr(text, keyword) > 0 Then Debug.Print ("sheet : " + inputBook.Worksheets(i).Name) Debug.Print ("text : " + text) End If Next groupedShape ' オートシェイプがグループ化されていない場合 ' そのオートシェイプのテキストをチェック Else text = parentShape.DrawingObject.Characters.text If InStr(text, keyword) > 0 Then Debug.Print ("sheet : " + inputBook.Worksheets(i).Name) Debug.Print ("text : " + text) End If End If Next parentShape Next i ' ファイルクローズ inputBook.Close SaveChanges:=True Set inputBook = Nothing Application.ScreenUpdating = True End Sub
オートシェイプはワークシート毎にShapes(index)プロパティで保持しています。そのプロパティから順次Shapeオブジェクトを取得して処理します。
オートシェイプのグループ化の有無によって処理は分岐します。グループ化の有無はparentShape.TypeがmsoGroupかどうかで判断します。
オートシェイプがグループ化されている場合、ShapeオブジェクトのGroupItemsプロパティにグループ化されたオブジェクトが保持されているので、そのプロパティを順次取得して保持しているテキストを取得します。グループ化されたオートシェイプをさらにグループ化している場合でも、オートシェイプはすべてGroupItemsに保持しているようです。(再帰処理なしでサブグループのオートシェイプがすべて取得できそうです)
オートシェイプがグループ化されていない場合は、Shapeオブジェクトの持つテキストをそのまま取得します。あとはInStrで検索キーワードが含まれるかどうかをチェックします。
関連記事:
minor.hatenablog.com