選択セル範囲を図形のテキストボックスにするマクロその3、図形の四角形をテキストボックス化

"普通のテキストボックス"と"図形にテキストを追加したもの"とではどんな違いがあるのかを少し調べてみた

結果は

ほとんど違いがない
移動させるときは図形のほうがラク
初期の見た目が違うけど設定で全く同じようにすることができる
これからはテキストボックスのかわりに図形にテキストを追加して使おう

移動させるときは図形のほうがラク

図形の方はマウスでつかめる範囲も広く、1回のクリックで掴んで移動できる

初期の見た目が違うけど設定で全く同じようにすることができる

見た目で違うのは色や線の太さ、文字の配置、これらは設定で色々変更できるので

テキストボックスを図形の四角形のようにできるし

図形の四角形をテキストボックスのようにもできる

ってことは図形の四角形の見た目をテキストボックスにすれば

移動がラクなテキストボックスができあがる！

VBAで見た目を変更するには

どのプロパティがどこに関連しているのか知る必要があるので

左から四角形、四角形にテキスト追加、テキストボックス

それぞれをShape型のオブジェクト変数に入れて中を覗いてみる

f:id:gogowaten:20191030151742p:plain

AutoShapeTypeは3つともmsoShapeRectangleだけど

TypeはmsoAutoShape、msoAutoShape、msoTextBoxとなっていて、四角形とテキストボックスとで区別がつけられるようになっている

Shape.TextFrame

f:id:gogowaten:20191030151755p:plain

テキスト全体の水平位置のHorizontalAlignmentと

テキスト全体の垂直配置のVerticalAlignmentが違う

テキストボックスのHorizontalAlignmentは指定なしになっているけど、見た目ではLeft

これらの設定は、このホームタブの配置と

右クリックメニューから図形の書式設定の

テキストボックスの垂直方向の配置

このあたりが関係しているみたい

エクセル2007は図形に対するマクロの記録ができないから手間がかかってめんどくさいので、このあたりは正確ではないかも

Shape.TextFrame2プロパティ

f:id:gogowaten:20191030151808p:plain

HasTextはテキストの有無を表しているみたい、図形だけの左のものだけFalseになっている

テキストの1行ごとの書式設定の

Shape.TextFrame2.TextRange.ParagraphFormat.Alignment

これの設定は

テキスト部分の右クリックメニューからの段落の設定画面のところ

四角形の段落の横配置は中央揃え

テキストボックスは指定なし

多分このあたりだと思う

テキストボックスは指定なしというか空白になっていて、値だとmsoAlignMixedになっているけど、見た目ではLeftだねえ

Shape.Line

テキストボックスの枠の色は

Shape.Line.ForeColor.ObjectThemeColorでmsoThemeColorLight1が指定されていて、色の濃淡のTintAndShadeは-0.5が指定されている、マクロで指定するときはRGBを使いたいから一旦テーマカラーで指定してRGBが出たところで指定し直す。

枠の太さはShape.Line.Weight

あとは背景色が違う、これはShape.Fill.ForeColor.RGBにvbWhite(白)を指定

まとめると

図形の四角形にテキスト追加して見た目をテキストボックスのようにするには

Shape(四角形)の

TextFrame2.ParagraphFormat.Alignment = msoAlignLeft
TextFrame.HorizontalAlignment = xlHAlignLeft
TextFrame.VerticalAlignment = xlVAlignTop
Line.Weight = 0.75
Line.ForeColor.ObjectThemeColor = msoThemeColorLight1
Line.ForeColor.TintAndShade = -0.5
Line.ForeColor.RGB = Line.ForeColor.RGB
Fill.ForeColor = vbWhite

前回のtestTableTextBox2メソッドを変更してできたのがTableTextBoxtest

'図形の四角形にテキスト追加バージョン

'2017/01/23

Sub TableTextBoxtest()
      '選択されているのがセル以外なら何もしないで終了
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    Dim myCells As Range:    Set myCells = Selection
    Dim tlCell As Range:    Set tlCell = myCells.Cells(1) '左上のセル
    
    'テキストボックス作成
    Dim myTB As Shape
    Dim ws As Worksheet: Set ws = ActiveSheet
    Set myTB = ws.Shapes.AddShape(msoShapeRectangle, _
        tlCell.Left, tlCell.Top, 100, 100)
    
'    テキストボックスに表示する文字列を作成
    Dim str As String
    Dim rRow As Range
    str = testGetString2(myCells)
    With myTB
        With .TextFrame2.TextRange
            'テキストボックスにテキスト指定
            .text = str
            '全体の段落の水平位置を左寄せに指定
            .ParagraphFormat.Alignment = msoAlignLeft
        End With
        With .TextFrame
            'テキスト全体の水平位置を左寄せに指定
            .HorizontalAlignment = xlHAlignLeft
            'テキスト全体の垂直位置を上寄せに指定
            .VerticalAlignment = xlVAlignTop
            .AutoSize = True 'オートサイズを有効にする
        End With
        .AlternativeText = "TextBox" '識別用に名前をつける
        .Placement = xlMove 'セルに合わせて移動するけどサイズ変更しない
'        .Placement = xlFreeFloating '移動もサイズ変更もしない
        .Fill.ForeColor.Rgb = vbWhite '背景色は白
        
        '枠線の設定
        With .Line
            .Weight = 0.75 '太さ
            .Style = msoLineSingle '１本線
            '枠線の色
            With .ForeColor
                'テーマカラーのLight1のShade-0.5をRGB指定
                .ObjectThemeColor = msoThemeColorLight1
                .TintAndShade = -0.5
                .Rgb = .Rgb
            End With
        End With
    End With
    
    'フォントカラーとフォントの設定
    Call SetFontColorAndFont(myTB, myCells)
    'セル幅に合わせたタブ位置を設定する
    Call AddTabPosition(myTB, myCells)
    
End Sub

Sub TableTextBoxtest()
'選択されているのがセル以外なら何もしないで終了
If TypeName(Selection) <> "Range" Then Exit Sub

Dim myCells As Range: Set myCells = Selection
Dim tlCell As Range: Set tlCell = myCells.Cells(1) '左上のセル

'テキストボックス作成
Dim myTB As Shape
Dim ws As Worksheet: Set ws = ActiveSheet
Set myTB = ws.Shapes.AddShape(msoShapeRectangle, _
tlCell.Left, tlCell.Top, 100, 100)

' テキストボックスに表示する文字列を作成
Dim str As String
Dim rRow As Range
str = testGetString2(myCells)
With myTB
With .TextFrame2.TextRange
'テキストボックスにテキスト指定
.text = str
'全体の段落の水平位置を左寄せに指定
.ParagraphFormat.Alignment = msoAlignLeft
End With
With .TextFrame
'テキスト全体の水平位置を左寄せに指定
.HorizontalAlignment = xlHAlignLeft
'テキスト全体の垂直位置を上寄せに指定
.VerticalAlignment = xlVAlignTop
.AutoSize = True 'オートサイズを有効にする
End With
.AlternativeText = "TextBox" '識別用に名前をつける
.Placement = xlMove 'セルに合わせて移動するけどサイズ変更しない
' .Placement = xlFreeFloating '移動もサイズ変更もしない
.Fill.ForeColor.Rgb = vbWhite '背景色は白

'枠線の設定
With .Line
.Weight = 0.75 '太さ
.Style = msoLineSingle '１本線
'枠線の色
With .ForeColor
'テーマカラーのLight1のShade-0.5をRGB指定
.ObjectThemeColor = msoThemeColorLight1
.TintAndShade = -0.5
.Rgb = .Rgb
End With
End With
End With

'フォントカラーとフォントの設定
Call SetFontColorAndFont(myTB, myCells)
'セル幅に合わせたタブ位置を設定する
Call AddTabPosition(myTB, myCells)

End Sub

これ以外のメソッドは前回と全く同じ