テキストボックス(Shape)をフォント(色/サイズ/太字/下線)付きでアウトプットする方法(VBA)

テキストボックス内の情報が取り出せなくて困っていませんか?

困るのも無理ありません
セルと比べてテキストボックスをVBAで扱うのは難易度が高いですから

そんな困りごとを解決するため、簡単に扱えるプログラムを紹介しようと思います。

この記事ではテキストボックス内の文字列をフォント付きでシート上へ貼付けるプログラムをお見せします。

なお、今回はテキストボックス(Shape)の文字列を取得する方法(VBA)の続編です。
テキストを貼付けるだけならばこちらの記事のプログラムのが簡単なのでオススメです。

テキストボックスをフォント付きでアウトプットする方法

これから紹介するプログラムでは、画像のようにシート上に存在するテキストボックス内のテキストをフォント含めてシート上に書き出していきます。

前回の内容の応用なので、TextFrame2/TextRangeが分からない場合は前回の記事を先に読んでください。

Sub OutTextBox()
'テキストボックスの中身を同じ書式でシート上にアウトプット

    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim oneShp As Shape
    Dim row_i As Long: row_i = 1
    For Each oneShp In ws.Shapes
        If oneShp.Type = msoTextBox Then 'テキストボックスのみ処理
            Call OutText(oneShp, ws.Cells(row_i, 2))
            row_i = row_i + 1
        End If
    Next
End Sub

Private Sub OutText(shp As Shape, outCell As Range)
'shpオブジェクトの中身を同じ書式でシート上にアウトプット

    'テキストボックス名/テキストを貼付け
    outCell.Offset(, -1) = shp.Name
    outCell = shp.TextFrame2.TextRange.Text
    
    Dim tmpTR As TextRange2
    Dim wsFont As Font
    Dim fromLeft As Long: fromLeft = 1
    Dim run_i As Long

    '書式を反映(文字色/サイズ/太字/下線)    
    For run_i = 1 To shp.TextFrame2.TextRange.Runs.count
        Set tmpTR = shp.TextFrame2.TextRange.Runs(run_i)
        Set wsFont = outCell.Characters(fromLeft, tmpTR.Length).Font
    
        With tmpTR.Characters.Font
            wsFont.Color = .Fill.ForeColor
            wsFont.Size = .Size
            If .Bold = msoTrue Then wsFont.Bold = True
            If .UnderlineStyle = msoUnderlineSingleLine Then wsFont.Underline = True
        End With
        
        fromLeft = fromLeft + tmpTR.Length
    Next

End Sub

Private SubのOutTextがメインの処理を行っています。

outCell = shp.TextFrame2.TextRange.Text

この部分で前回と同じようにテキストボックス内のテキストをすべて書き出しています。

テキストをすべて書き出した後に、書式を反映させていっています。

ポイントはTextRangeのRunsプロパティ

このプログラムのポイントはTextRangeのRunsプロパティです。

TextRangeはテキストボックスのテキスト自体を処理するためのオブジェクトでしたね

RunsプロパティはTextRangeを同じ書式のブロックに切り分ける役割を果たします。

今回の場合は、あい、う、え、おの4種類がブロックに分割されます。
返り値はTextRangeオブジェクトで、この分割されたブロックをTextRangeオブジェクトとして返します。

    For run_i = 1 To shp.TextFrame2.TextRange.Runs.count
        Set tmpTR = shp.TextFrame2.TextRange.Runs(run_i)
        Set wsFont = outCell.Characters(fromLeft, tmpTR.Length).Font

For文の後に、Runsプロパティを用いて分割されたTextRangeオブジェクトをSetしています。

そして、その次の行で分割されたTextRangeオブジェクトに対応するセルの文字列のフォントをSetしています。
(Charactersプロパティが分からない場合は公式リファレンスを読んでみてください)

残りの処理はTextRangeのフォントとセルの文字列のフォントを一致させているだけです。

ちょっと理解が難しいプログラムなので、Forループの部分をステップ実行して観察してみてください

筆者おすすめのVBA本はこちらです。

created by Rinker
技術評論社
¥2,178 (2021/10/18 10:25:13時点 Amazon調べ-詳細)
created by Rinker
¥2,948 (2021/10/18 21:50:31時点 Amazon調べ-詳細)

《VBA上級者を目指す人へのおすすめ》

created by Rinker
技術評論社
¥3,608 (2021/10/18 10:25:15時点 Amazon調べ-詳細)

他の「VBA」の記事はこちらからどうぞ

VBA

Posted by やろまい