Excelのテキストボックスなんとかならんか

*この記事は2010/11/02に掲載したものですが、参照される方が多いようなのでブログ移転後も同じURLに移しました。
偶然にもこれ書いたのちょうど2年前なのですね。

Excelのテキストボックスがいっぱい貼り付けられたブック、フロー図なんかでよくあります。
一括変換処理しようにもテキストボックスって普通の検索や置換でひっかからないんですよね。
そんなわけでネットに転がってるサンプルとかにちょっとひと工夫してマクロ作りました。

「Visual Basic Editor」を開いてぴたっと下のコードを貼り付けましょう。

あと、変換用に「検索対象」の文字列をA列に、「置換対象」の文字列をB列に入れた
変換リストのシートを用意しましょう。
下のコードではこのシートを「changetable」という名前しています。

あとはマクロの実行でGO！です。

=========＜コードはここから＞=========

Sub replist()
    Dim list_sheet As Worksheet
    Dim chg_sheet As Worksheet
    Dim cnt As Integer
    Dim srcword As String
    Dim repword As String
    Dim txtbox As Object
    ‘ 置換する元の文字列(A列)と先の文字列(B列)のリストを作っておいて指定
    Set list_sheet = Worksheets(”changetable”)
    cnt = list_sheet.Range(”a1″).CurrentRegion.Rows.Count
    Application.ScreenUpdating = False
    ‘ すべてのシートに対して処理
    For Each chg_sheet In Worksheets
        ‘ リストのシートは除外
        If chg_sheet.Name <> list_sheet.Name Then
            ‘ 処理対象のシートをアクティブにする
            chg_sheet.Select
            ‘ 置換対象のリスト数だけLoop処理
            For i = 1 To cnt
                srcword = list_sheet.Cells(i, “A”).Value
                repword = list_sheet.Cells(i, “B”).Value
                ‘ すべてのテキストボックスに対して置換
                For Each txtbox In ActiveSheet.Shapes
                    If txtbox.Type = msoTextBox Then
                        txtbox.DrawingObject.Text = _
                                Replace(txtbox.DrawingObject.Text, srcword, repword, 1, -1, vbTextCompare)
                    End If
                Next
            Next i
        End If
    Next chg_sheet
    Application.ScreenUpdating = True
End Sub