Excel VBAでテキストボックスの 背景色・枠の変更方法

Excelのシートに文字を表示させると一部のセルだけの列幅や行高さだけを変更できないため
A. セル範囲を超えた文字表示ができないことがあったり、
B. 文字列を縦書きにすると行全体の高さが高くなってしまって全体のレイアウトが崩れたり(図-0)などという制約がある。
こうした場合「テキストボックス」を挿入すると任意の位置に任意の大きさで文字表示が可能で、「縦書きテキストボックス」を配置すれば表示位置の行高さなどに影響を与えずに日本語文字の縦書き表示も可能になる。
しかし一口に「テキストボックス」と言っても Excelには以下のように３種類ある。
① 普通にシートに「挿入」＞「図形」＞「(縦書き)テキストボックス」で挿入したテキストボックス。－－図-1
③ シートに 「開発」＞「挿入」＞「Active-Xコントロール」で挿入したテキストボックス。－－図-2
③ 更に Excel VBAで表示させる「Form」にも「テキストボックス」がある。－－図-3
ここで説明する「テキストボックスの枠・背景色」などのプロパティの変更方法は ① のテキストボックスについて。
テキストボックスを使って単純に文字表示を行ったり、手動で枠の大きさを変更するなら問題ないが、VBAを使ってテキストボックスの大きさや枠の色、塗りつぶし色を変更しようと Webで「テキストボックスの枠の変更」などで検索して見つけたサンプルコードを試してもうまく動かないことが多かった。
ポイントは上記の ①～③ の変更対象の「テキストボックス」の挿入方法の違いだったので、このページをアップすることにした。

1. ① ＜第１の方法＞
オブジェクト名を指定して直接色や線種類などのプロパティを編集する。
単一のオブジェクトのプロパティを編集するのに適している。




「テキスト ボックス 1」などのオブジェクト名は、半角空白や数字の半角など正確に記述しないと「オブジェクトが存在しない」というエラーになる。正確なオブジェクト名を知るには対象のオブジェクトを選択するとシートの左上の「名前ボックス」に表示されるので全体をドラッグして選択し「Ctrl＋C」でコピーする。





或いは「ホーム」タブ ＞「検索と選択」＞「オブジェクトの表示と選択」をクリックすると、シートの右側に「オブジェクトの選択と表示」ウインドウにオブジェクトのリストが表示されるのでその中の該当のオブジェクト名を選択すると、そのオブジェクトが選択状態になることで確認する。






例えば "テキスト ボックス 1" の塗り潰しを赤に設定する場合は

Worksheets(1).DrawingObjects("テキスト ボックス 1").ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

などとする。色の設定は .SchemeColor プロパティ(1～80の整数値)でも設定が可能だ。
また設定した色は
.ShapeRange.Fill.Visible = msoFalse　となっていると表示されないので msoTrue を設定し
.ShapeRange.Fill.Transparency = 0.8 などと透明度も設定した方が確実だ。
全体としては以下のようになる。

      With Worksheets(1).DrawingObjects("テキスト ボックス 1")
          .Text = "TextBox 1"
          .ShapeRange.Fill.ForeColor.ShapeRange.Fill.Transparency = 0.8 = 3        ' 塗りつぶし色
          .ShapeRange.Fill.Visible = msoTrue              ' 塗り潰しの表示
          .ShapeRange.Fill.Transparency = 0.8            ' 透明度
          .ShapeRange.Fill.ForeColor.SchemeColor = clrindx       ' 塗り潰し色
      End With
      




---



2. ② ＜第２の方法＞
オブジェクト名で一旦選択状態にして、選択オブジェクトを指定してプロパティを編集する。
複数のオブジェクトを指定して一括でプロパティを変更するのに便利。
実際のコードサンプルは以下。


      Sub ボタン3_Click()
        Dim str1 As String
        Dim i, ci As Integer

        With Worksheets(1).DrawingObjects("テキスト ボックス 3")
            .Text = "TextBox 3"
            .ShapeRange.Line.BackColor.RGB = RGB(0, 0, 0)
            .ShapeRange.Line.DashStyle = msoLineSolid
            .ShapeRange.Line.ForeColor.RGB = RGB(256, 200, 200)
            .ShapeRange.Line.Visible = msoTrue
            .ShapeRange.Fill.ForeColor.SchemeColor = 3
        End With

        With Worksheets(1)
            ci = .Shapes.Count
            For i = 1 To ci
                str1 = .Shapes(i).Name
                If str1 = "TextBox 1" Then
                    .Shapes(i).Select
                    Selection.ShapeRange.Fill.Visible = msoTrue
                    Selection.ShapeRange.Fill.Transparency = 0.8
                    Selection.ShapeRange.Fill.ForeColor.SchemeColor = .Range("D17").Value
                    .Range("D17").Value = .Range("D17").Value + 1
                End If
            Next i
            .Shapes("TextBox 3").Select
            Selection.ShapeRange.Fill.ForeColor.SchemeColor = .Range("D17").Value
            .Range("D17").Select
        End With
      End Sub