[Excel VBA] シート内の全てのシェイプに対してテキスト置換えをする

2014年6月10日 propg Excel, VBA, 2

Excelの検索/置換機能はとても便利ですが、シェイプに対しては機能しません。
そのため、シェイプを多用して、テキスト配置を行っている場合、文字列の置換えはかなり面倒なことになります。

というわけで、シート内の全てのシェイプに対して文字列を置換えするマクロを作りました。
基本的にはShapes内をループすればよいのですが、Excelにはグループという機能があります。
Shapesだけだと、グループ内に含まれるシェイプが対象になりませんので、再起処理でグループの中の中まで検索しにいきます。

Public Sub ReplaceAllShapeText(searchText As String, replaceText As String)

    Dim sh As Worksheet
    Dim sp As Shape
    
    Set sh = Application.ActiveSheet
    
    For Each sp In sh.Shapes
        ReplaceShapeText sp, searchText, replaceText
    Next

    Set sh = Nothing

End Sub

Sub ReplaceShapeText(sp As Shape, searchText As String, replaceText As String)
    On Error Resume Next
    
    Dim sp2 As Shape
    Dim t As String
    
    If sp.Type = msoGroup Then
        For Each sp2 In sp.GroupItems
            ReplaceShapeText sp2, searchText, replaceText
        Next
    Else
        t = sp.TextFrame.Characters.Text
        '矢印などテキスト設定できないシェイプの場合はエラーになる
        If Err Then
            Call Err.Clear
        Else
            sp.TextFrame.Characters.Text = Replace(t, searchText, replaceText)
        End If
    End If

End Sub

実際に実行する際には、

Sub Test()
    ReplaceAllShapeText "検索文字", "置換文字"
End Sub

のようなマクロを実行すればOKです。

このシェイプに対する再起処理ループの仕組みはほかにもいろいろ使えそうです。
応用すればもっと便利なこともできそうなので、ぜひお試しを。

 

== ランキングに参加しています。ぜひクリックお願いします ==

[VBA] イミディエイトウィンドウが表示されなくなったとき [Excel] セルの書式設定を使いこなす！