Excelで、テキストボックスのフォントを保持したまま文字列置換を行うVBA

Tweet

はじめに

本記事では、Excelにおいて、あるシート状にある全てのテキストボックス上の文字列に対して、フォントを変えずに一括で文字列置換を行うVBAを紹介します。

テキストボックスの文字をVBAで変更する方法は、比較的多く紹介されています。特に多いのは、シート上にあるすべてのオブジェクトである一定の文字列を探し出し、それらをすべて別の文字列に置換するコードです。僕も実務において、文字列置換が必要になり、ネットで見つけたいくつかのコードを早速試してみました。しかし、文字列置換はできたものの、うまくいかない場合がありました。

うまくいかない場合とは、一番上の図のように、1つのテキストボックス内に複数の書体を含んでいる場合です。図の「あいうえお」の部分を「abcde」に置き換えたいのですが、多くのサイトで紹介されているソースコードを実行すると、下図のようにフォントや色、サイズ、配置（中央揃え）が統一されてしまうのです。

したがって、単に文字列置換をするだけでなく、「フォントを保持したまま、文字だけを置換する」にはどうすればいいかについて非常に悩みました。

分かってしまえば簡単なことだったのですが、同じ悩みを持って検索される方もいらっしゃるかもしれないので、ここに記しておきます。

なお、動作確認はExcel2013でのみ行っておりません。

フォントが統一されてしまう理由

まず、なぜ上のようにフォントが統一されてしまうかを考えてみたいと思います。
ネットで見かけた多くのソースコードは以下のようなものでした。

ちなみに、本記事では、目的とするコードを「シート上に存在するすべてのテキストボックス内の『あいうえお』という文字列を『abcde』に変更する」というものに統一します。

Sub 文字列置換1()
   Dim shp As Shape, buf1 As String, buf2 As String
   For Each shp In ActiveSheet.Shapes
      'テキストボックスの場合
      If (shp.Type = msoTextBox) Then

         '現在のテキストボックスの文字列
         buf1 = shp.TextFrame.Characters.Text

         'あいうえおという文字列が含まれていれば以下を実行
         If (InStr(buf1, "あいうえお") <> 0) Then

         '置換後の文字列・・・あいうえおをabcdeに置換
            buf2 = Replace(buf1, "あいうえお", "abcde")
            'テキストボックスに文字列を張り付ける
            shp.TextFrame.Characters.Text = buf2
         End If
      End If
   Next shp
End Sub

このコードは、全てのテキストボックスに対して、テキストボックス上に書かれた文字列を全て取り出し、取り出した文字列に対して「あいうえお」を「abcde」に置換してから、再度テキストボックスに貼りなおす、という流れになっています。一見問題ないように思いますが、これを実行すると、先ほど述べたようにフォントが統一されてしまいます。

これはなぜかと言いますと、同じことを手動で行ってみればわかりやすいと思います。
手動で行った場合、まず、テキストボックスの文字列を全選択し、いったんすべて削除します。そして、削除した箇所から改めて文字を打ち直す、という作業と同じことをやっているのです。

当然、文字列を削除した時点で、フォントの情報はテキストボックスの先頭の情報以外すべて失われます。ですから、あらためて同じような文章を打ち直しても、途中からのフォント変更の情報はもはや記憶しておらず、全ての文字が同じフォントで書かれてしまうことになります。

プログラム上でも同じことが起こっているため、冒頭で述べたような現象に陥ってしまうのです。

ちなみにこの現象は、文字列を置換したかどうかは全く関係なく、仮に、文字列を取得してそのまま代入しなおすだけでも、同じようにフォントは失われてしまいます。

テキストボックス内でフォントを変えるなどという使い方をしなければ、上記のソースコードでも全く問題ありませんが、最初の図のようにテキストボックス内で多数のフォントを使っている場合はどうすればよいのでしょうか？

フォントを保持しつつ、テキストボックスの文字列を置換するコード

Sub 文字列置換2()
   Dim shp As Shape, buf1 As String, lg As Integer, place As Integer
   'シート内にある全てのオブジェクトでループ'
   For Each shp In ActiveSheet.Shapes

      'テキストボックスの場合
      If (shp.Type = msoTextBox) Then

         '置換対象の部分文字列の長さ
         lg = Len("あいうえお")

         Do While (1) '同じ文字列が複数存在する可能性がなければ、このループは不要です。

            '現在のテキストボックスの文字列をゲット
            buf1 = shp.TextFrame.Characters.Text

            'あいうえお'の文字列を検索する。
            '存在しなければ0が、存在すればその場所が数値で返る'
            place = InStr(buf1, "あいうえお")

            '「あいうえお」がなければループを抜ける
            If place = 0 Then Exit Do
      
            'テキストボックスのplace番目の文字列からlgの長さ分だけ
            '「abcde」に置き換える。
            shp.TextFrame.Characters(place, lg).Text = "abcde"
         Loop
      End If
   Next shp '次のオブジェクトへ'
End Sub

実際にこのコードを実行したところ、図のように意図した通りにフォントを変えずに置換できました。（abcdeの部分だけフォントが異なるように見えますが、これはデフォルトの設定が日本語と英語でフォントが異なるからです）

コードの説明

こちらのコードと、最初に上げたコードの違いは、最初に上げたものが、「文字列全体を取り出して文字列全体を貼りなおす」、というものであったのに対して、後で紹介したコードは、「置換文字列がある部分だけを修正する」というものです。

まず、10行目で”あいうえお”の長さ(10バイト）を求めておきます。また、19行目 で、”あいうえお”が見つかった位置（文字列全部の左からのバイト数）を変数placeに記憶しておきます。
これらの2つを、26行目で、Charactersメソッドに代入することで、指定した部分だけを置換することができるのです。
Charactersメソッドに引数をつけると、文字列全体のうち、第一引数の位置から、第二引数の長さ分にだけアクセスできるのです（このことをなかなか発見できなかったので、解決するのに時間がかかりました）。
したがって、この命令は、「place番目の文字から、10バイトの長さ分の文字列を、abcdeに置き換えよ」という意味になります。
これを手動でやると、「『あいうえお』をマウスで選択状態にし、その状態でキーボードで『abcde』と入力する」と同じことになるでしょう。だから、もともと「あいうえお」となっていた部分以外には一切影響を及ぼしません。その結果、「あいうえお」が元々保持していたフォントのまま、文字だけが「abcde」に変更されるため、冒頭で述べた問題が解決されるのです。

先の失敗例では、Charactersメソッドの引数を省略していました（というか、引数があることすら知りませんでした）。その場合は、「最初の文字から、全部選択」という意味になるようです。

変更したのは、「全部を選択して置き換える」か、「部分的に選択して置き換える」か、たったそれだけなのですが、その違いによって結果的には大きな違いが出たのでした。

ちなみに、本記事の本筋とは異なりますが、その外のDo While のループについて一応解説しますと、このループは、1つのテキストボックス内に「あいうえお」が2つ以上存在する場合でも全て置換できるようにするためのものです。2つ以上存在することがあり得ないなら、While文はない方が処理速度がアップするでしょう。

また、「”あいうえお”がソースコード内に2度登場するので、定数か変数にした方がいいんでないか」という突っ込みもあると思いますが、これは、ソースコードを見てもらう際、直接文字列をコード内に書いた方がわかりやすいかなと思って、あえてそのようにしているだけです。

応用

テキストボックス以外でも使える？

今回は、テキストボックスを例に説明しましたが、テキストボックス以外のオートシェープなどを含んでいても問題ありません。

7行目の、If (shp.Type = msoTextBox) Then　の条件文のところに、msoAutoShapeなどもor文でくっつければ、オートシェープ上の文字列も同じように置換できることは確認しております。ただし、文字列に対応していない図形があった場合はエラーになるので注意してください。

グループ化されたオブジェクトにある文字は置換できない？

もし、グループが解除されてしまっても運用上問題ないのであれば方法はあります。グループを解除して、全てのオブジェクトをバラバラにしてから、本記事の方法を行えばよいのです。
グループを全階層にわたって全解除する方法は、以下の記事で紹介しておりますので参考にしてみてください。

Excelで、全ての図形のグループ化を、全階層解除するVBAの書き方

問題は、グループを解除したくない場合です。グループを解除せずに、グループも含めて全てのオブジェクトにアクセスして文字列を操作する必要があり、難易度が跳ね上がりますね。再帰関数か何かでグループの階層奥深くまで全て走査すればよいのでしょうか。この点は今後の課題としたいと思います。

まとめ

ものすごい発見をしたかのような書き方をしましたが、実際にやったことは、たいしたことではありません。引数が省略されていたメソッドの引数を、普通に省略せずに書いたら即座に解決してしまったというお話でした。慣れている人なら、検索などせずとも自力で解決してしまう内容でしょう。

しかし、プログラミングをしていると、こんな簡単なことにドツボにはまって何日も解決できないことがよくあるのです・・・。同じようにドツボにはまって悩んでいる人が、たまたま運よくこの記事を発見して問題を解決していただけたのならとてもうれしいです。