Word MVPの新田さんのブログで気になる記事がありました。

“テキストボックス内の文字を置換するマクロ”

テキストボックス等Shapeオブジェクトのテキストのみを置換するWordマクロです。
これまで本文のみ、もしくはオートシェイプを含めた文書全体の文字列置換というのは行ったことがあるのですが、Shapeオブジェクトのみを対象とした文字列置換は行ったことがなかったので、私の方でも試してみました。

Option Explicit

Public Sub Sample()
  Dim Shp As Shape
  Dim GrpShp As Shape
  Dim CvsShp As Shape
  Dim CvsGrpShp As Shape
  
  Const SrcText As String = "あいうえお" '検索する文字列
  Const DestText As String = "かきくけこ" '置換後の文字列
  
  For Each Shp In ActiveDocument.Shapes
    If Shp.Type = msoCanvas Then
    '描画キャンバスの場合の処理
      For Each CvsShp In Shp.CanvasItems
        If CvsShp.Type = msoGroup Then
          For Each CvsGrpShp In CvsShp.GroupItems
            ReplaceShapeText CvsGrpShp, SrcText, DestText
          Next
        Else
          ReplaceShapeText CvsShp, SrcText, DestText
        End If
      Next
    ElseIf Shp.Type = msoGroup Then
    'グループ化されている場合の処理
      For Each GrpShp In Shp.GroupItems
        ReplaceShapeText GrpShp, SrcText, DestText
      Next
    Else
      ReplaceShapeText Shp, SrcText, DestText
    End If
  Next
End Sub

Private Sub ReplaceShapeText(ByVal Shp As Shape, ByVal SrcText As String, ByVal DestText As String)
  If Shp.TextFrame.HasText Then
    '検索条件は適当に設定
    With Shp.TextFrame.TextRange.Find
      .ClearFormatting
      .Forward = True
      .Text = SrcText
      .Replacement.Text = DestText
      .Execute Replace:=wdReplaceAll
    End With
  End If
End Sub

新田さんのマクロではSelectionオブジェクトを利用していますが、上記コードでは、ShapeオブジェクトのTextFrameプロパティ(TextFrameオブジェクト)にあるTextRangeプロパティからRangeオブジェクトを取得できるので、これを利用してみました。

描画キャンバスとグループ化されたアイテムだけは考慮していますが、それ以外は特別な処理をしていませんので、上記コードでは対応できない場合があるかもしれません。

Shapeオブジェクトのみ、ということで中々出番が無いかもしれませんが、こういったマクロも面白いですね(^^)