0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

Excel VBA 今日のトリビア テキストボックスの横書きを水平方向に中央にするのと、縦方向に中央にするのは全く違う

Posted at

問題1:テキストボックスを垂直、水平方向に中央にするには?

テキストボックスを挿入し、文字を編集する状態にします。
image.png

image.png

今水平方向は中央ですが、文字列自体は左に行っています。これを真ん中にするにはどうするのか。
image.png

考察1:垂直方向はVerticalAnchor

Sub FaileSample()
'これはエラーになります
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim xShps As Excel.Shapes, xShp As Excel.Shape
    Dim xShpR As Excel.ShapeRange
    ' Office.MsoTextOrientation msoTextOrientationHorizontal = 1;msoTextOrientationVerticalFarEast = 4;msoTextOrientationVertical = 5
    'https://docs.microsoft.com/ja-jp/office/vba/api/office.msotextorientation
    ' 図形を消去
    ws.Shapes.SelectAll
    Selection.Delete
    
    ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 28.5, 36, 109.5, 27 _
        ).Select
    Set xShp = ws.Shapes.Item(1)
    xShp.Name = "TextBox 1"
    With Selection.ShapeRange.TextFrame2
        .VerticalAnchor = msoAnchorMiddle
        .HorizontalAnchor = msoAnchorMiddle
    End With

ここで垂直方向の中央揃えは

.VerticalAnchor = msoAnchorMiddle

ここは間違いないです。
そうすると普通はTextFrame2オブジェクトTextFrame2.HorizontalAnchorを使おうと思います。
TextFrame2.HorizontalAnchorの解説にも、

指定したテキストの水平方向のアンカーの種類を設定または返します。 読み取り/書き込みが可能です

と書いています。
TextFrame2オブジェクトにも
? Shape、 ShapeRange、または ChartFormat オブジェクト の テキスト フレーム を表 します。
解説
このオブジェクトには、レイアウト枠の配置や向きを制御するプロパティやメソッドだけでなく、レイアウト枠のテキストが含まれます。 TextFrame2 オブジェクトを取得するには、TextFrame2 プロパティを使用します。

.HorizontalAnchor = msoAnchorMiddle

こう書くと思うのが普通です。
ところが
:::note info
実行時エラー 80070057
指定された値は境界を超えています
:::

image.png

考察2-1:ここでさらに変数を使うとエラーメッセージが変化

Sub FaileSample2()
'これはエラーになります
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim xShps As Excel.Shapes, xShp As Excel.Shape
    Dim xShpR As Excel.ShapeRange
    ' Office.MsoTextOrientation msoTextOrientationHorizontal = 1;msoTextOrientationVerticalFarEast = 4;msoTextOrientationVertical = 5
    'https://docs.microsoft.com/ja-jp/office/vba/api/office.msotextorientation
    ' 図形を消去
    ws.Shapes.SelectAll
    Selection.Delete
    
    ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 28.5, 36, 109.5, 27 _
        ).Select
    Set xShp = ws.Shapes.Item(1)
    xShp.Name = "TextBox 1"
    With xShp.ShapeRange.TextFrame2 ' ここだけ変数を使う
        .VerticalAnchor = msoAnchorMiddle
        .HorizontalAnchor = msoAnchorMiddle
    End With

実行時エラー 438
オブジェクトは、このプロパティまたはメソッドをサポートしていません

image.png

という全く別のものになります。

考察3:HorizontalAnchorの変数?

考察3-1:変数を使う場合

    Set xShp = ws.Shapes.Item(1)
    xShp.Name = "TextBox 1"
    With xShp.ShapeRange.TextFrame2
        .VerticalAnchor = msoAnchorMiddle
        .HorizontalAnchor = msoAnchorCenter
    End With

考察3-2:Selectionを使う場合

    Set xShp = ws.Shapes.Item(1)
    xShp.Name = "TextBox 1"
    With Selection.ShapeRange.TextFrame2
        .VerticalAnchor = msoAnchorMiddle
        .HorizontalAnchor = msoAnchorCenter
    End With

この2つはどうでしょうか

考察3-3:答え

答えをいうと、変数はやはり同じエラーになります。
Selectionはエラーになりませんが、
ですが、
image.png
この状態のままで実は失敗しています。

つまりHorizontalAnchorではありません。

正解:長いよ

    ActiveSheet.Shapes.Range(Array("TextBox 1")).Select
    Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
        msoAlignCenter

実は横書きのテキストボックスで垂直方向に中央にするのはShapeRangeではなく、なんとShape.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment
ParagaphFormatなのです。
もうちょっと長くしていうと
Shape.ShapeRange.TextFrame2,Textrange
日本語でいうと、図形の図形枠の中にあるテキスト枠のテキスト範囲となります。
なぜこんな長くなるのかというと、まず図形自体がこんな四角四面ではないからです。丸もあるし色々です。なので図形枠という概念が生まれます。次にテキストの枠も四角四面とは限りません。なのでこうなります。
通常の思考では四角四面のテキストボックスでは図形枠やテキスト枠、テキスト範囲はすべて一致しています。
なのでShape.Textとかかけないのはなぜだということになります。

Sub Macro3_1()
Dim myDocument  As Worksheet
Set myDocument = Worksheets(1)
myDocument.Shapes.SelectAll
Selection.Delete
With myDocument.Shapes.AddShape(msoShape8pointStar, _
 0, 0, 250, 140).TextFrame
  With .Characters
 .Text = "Here is some test text"
   With .Font
    .Size = 11
    .Name = "MS ゴシック"
  End With
End With
 .MarginBottom = 10
 .MarginLeft = 10
 .MarginRight = 10
 .MarginTop = 10
 .HorizontalAlignment = xlHAlignCenter
 .VerticalAlignment = xlVAlignCenter
End With
End Sub

TextFrame2.TextRange property (Excel)

Returns the TextRange2 object that represents the text in the object. Read-only.

TextFrame2.TextRange プロパティ (Excel)

オブジェクト内の テキストを表す TextRange2 オブジェクトを返します。 読み取り専用です。

考察4:ここで対比と別解としてTextFrameを使う

しかしここでは終わりません。
TextFrame オブジェクト (Excel)

TextFrame オブジェクト (Excel)
Shape オブジェクトのテキスト フレームを表します。このオブジェクトには、レイアウト枠の配置およびアンカーを制御するプロパティやメソッドだけでなく、レイアウト枠のテキストが含まれています。
注釈
TextFrame オブジェクトを取得するには、ShapeオブジェクトのTextFrameプロパティを使用します。

公式のサンプルは全く動かないので、ちょっと付け加えます。
ここでアンカーを打ちます。

Sub Macro3()
Dim myDocument  As Worksheet
Set myDocument = Worksheets(1)
myDocument.Shapes.SelectAll
Selection.Delete
With myDocument.Shapes.AddShape(msoShapeRectangle, _
 0, 0, 250, 140).TextFrame
  With .Characters 'TextFrame2では使わない
 .Text = "Here is some test text"
   With .Font
    .Size = 11
    .Name = "MS ゴシック"
  End With
End With
 .MarginBottom = 10
 .MarginLeft = 10
 .MarginRight = 10
 .MarginTop = 10
 .HorizontalAlignment = xlHAlignCenter 'TextFrame2では使わない定数
 .VerticalAlignment = xlVAlignCenter 'TextFrame2では使わない定数
End With
End Sub

TextFrame.Characters メソッド (Excel)
を使っています。

問題2:Textrange と Charactersどちらが本命か

機能的には同じように見えますが、これを見分ける基準は、公式サイトの左の目次です。

考察5:Charactersはある

image.png
ずっと下に行きます。
image.png
Charactersオブジェクトはありました。
Charactersはセルのときも使います。
こちらが実は正当なはずですが、強引にTextFrame2を作っているためおかしなことになっているわけです。

考察6:TextRangeははない

さらに下に行きます。

image.png

本来ならここにTextrangeがあってもおかしくないのですが、ありません。

考察7:TextFrame2は2003にはない

Offce2003のTextFrame Object [Excel 2003 VBA Language Reference]

image.png

実際にOffice2007から追加されています。

考察8:定数の違い

XlVAlign 列挙 (Excel)
XlHAlign 列挙 (Excel)
位置を決めている定数はmsoではなくxlから始まっており、この点でも由緒正しいです。

考察9:TextFraemとTextFarme2の使い分け

ExcelのTextFrameとTextFrame2のプロパティ比較一覧 - relief
ここで比較すると機能が増えています。
しかしながらこれまでみてきたように
image.png
この部分は実際はTextFrameは確かですがTextRange2は同じではありません。

When to use TextFrame or TextFrame2 in VBA - StackOverflow
StackOverFlowではこのように後方互換を考えるとTextFrameを使ったほうがいいとあります。

:exclamation:考察10:TextFrameで作ってもTextFrame2で書式設定できる

Sub Macro3_1()
Dim myDocument  As Worksheet
Set myDocument = Worksheets(1)
myDocument.Shapes.SelectAll
Selection.Delete
With myDocument.Shapes.AddShape(msoShape8pointStar, _
 0, 0, 250, 140)
 .Name = "8-Point Star 16"
  .ShapeStyle = msoLineStylePreset16
  With .TextFrame.Characters
 .Text = "Here is some test text"
   With .Font
    .Size = 11
    .Name = "MS ゴシック"
  End With

End With
 .TextFrame.MarginBottom = 10
 .TextFrame.MarginLeft = 10
 .TextFrame.MarginRight = 10
 .TextFrame.MarginTop = 10
 .TextFrame.HorizontalAlignment = xlHAlignCenter
 .TextFrame.VerticalAlignment = xlVAlignCenter
 With .Line
         .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent4
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.25
        .Transparency = 0
 End With

End With

End Sub
Sub Macro3_2()

    ActiveSheet.Shapes.Range(Array("8-Point Star 16")).Select
    Selection.Placement = xlFreeFloating
    Selection.ShapeRange.ShapeStyle = msoShapeStylePreset12

    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent6
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0.400000006
        .Transparency = 0
    End With
    With Selection.ShapeRange.Glow
        .Color.ObjectThemeColor = msoThemeColorAccent4
        .Color.TintAndShade = 0
        .Color.Brightness = 0
        .Transparency = 0.6000000238
        .Radius = 11
    End With
    Selection.ShapeRange.TextFrame2.WordArtformat = msoTextEffect33 ' <== ここでTextFreme2
    With Selection.ShapeRange.TextFrame2.TextRange.Font.Glow
        .Color.ObjectThemeColor = msoThemeColorAccent2
        .Color.TintAndShade = 0
        .Color.Brightness = 0
        .Transparency = 0.6000000238
        .Radius = 18
    End With
End Sub

image.png

結論 TextFrame2ではなくTextFrameでテキストボックスは作ったほうがよい

通常は枠を作ってテキストが入りさえすれば、誰も文句は言わないでしょう。
そういうレベルでは、後方互換や可読性を考えると、横書きのテキストボックスはTextFrameで作ったほうが可読性があり、設定が簡単です。

Sub InsertTextBox()
' For Excel VBA
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.ActiveSheet
    Dim xShps As Excel.Shapes, xShp As Excel.Shape
    Dim xShpR As Excel.ShapeRange
    ' 図形削除
    ws.Shapes.SelectAll
    Selection.Delete
    ws.Shapes.AddTextbox(msoTextOrientationHorizontal, 28.5, 36, 219, 27).Select
    Selection.Locked = msoTrue
    Selection.PrintObject = True
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0.5
        .Solid
    End With

    Set xShp = ws.Shapes.Item(1)
    xShp.Name = "TextBox 1"
    xShp.ShapeStyle = msoShapeStylePreset17
    xShp.Height = 19.842519685
    xShp.Select '半透明にするにはここで一度セレクトする
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent2
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0.5
        .Solid
    End With
    With xShp.Line
    .DashStyle = msoLineDashDot
    .Visible = msoTrue
    End With
    xShp.LockAspectRatio = msoFalse '縦横比を固定 テキストボックスは縦のみ、横のみが多いので外す
    xShp.Placement = xlFreeFloating ' セルに合わせてサイズ変更したり移動したりしない
    xShp.Locked = False
    With xShp.TextFrame
        With .Characters
             .Text = "Here is some test text"
           With .Font
                .Size = 11
                .Name = "MS ゴシック"
           End With
       End With
    .MarginBottom = 10
    .MarginLeft = 10
    .MarginRight = 10
    .MarginTop = 10
    .HorizontalAlignment = xlHAlignCenter
    .VerticalAlignment = xlVAlignCenter
    End With
End Sub
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?