円に添うワードアートを作る

このようにしたい。

文字を円状に変形させる手順は、図形の書式＞文字の効果＞変形＞円。
オートシェイプの円を作成して直接文字を追加して文字を円状に変形させるとこうなる。内側すぎる。物足りない。

円とは別にワードアートを同じサイズで作ってみる。惜しい。

少しだけワードアートのサイズを円よりも大きくすれば合いそう。
円状の文字を別の円に完璧に添わせるには、中心を同じにする。
大きさの違うオートシェイプの中心を計算して、ワードアートのサイズを微調整して（ｒｙ

できたのがコレ。ざっくり。

Sub 円に添うワードアートを作成する試行錯誤()
    
    '共通の中心点をここで指定
    Dim 中心点Left As Double
    Dim 中心点Top As Double
    中心点Left = Range("D12").Left
    中心点Top = Range("D12").Top
    
    Dim 円Left As Double
    Dim 円Top As Double
    Dim 直径 As Double
    
    Dim 半径 As Double
    半径 = 100 '円のサイズをここで指定
    
    円Left = 中心点Left - 半径
    円Top = 中心点Top - 半径
    直径 = 半径 * 2
    
    Dim myShape As Shape
    Set myShape = Shapes.AddShape(msoShapeOval, 円Left, 円Top, 直径, 直径)
    
    myShape.Line.Weight = 2
    myShape.Line.ForeColor.RGB = rgbBlue '外枠
    myShape.Fill.Visible = msoFalse '塗りつぶし無し
    'myShape.Fill.ForeColor.RGB = iForeColor '塗りつぶし色
    
    
    Dim ワードアートサイズ As Double
    ワードアートサイズ = 104 'ここで指定。半径であることに注意。
    
    Dim 文字Left As Double
    Dim 文字Top As Double
    文字Left = 中心点Left - ワードアートサイズ
    文字Top = 中心点Top - ワードアートサイズ
    
    Dim msg1 As String
    msg1 = "あいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよわをん"
    
    Set myShape = Shapes.AddTextEffect(msoTextEffect1, msg1, "ＭＳ Ｐゴシック", 30, _
        msoFalse, msoFalse, 文字Left, 文字Top)
    
    myShape.Height = ワードアートサイズ * 2
    myShape.Width = ワードアートサイズ * 2
    myShape.TextEffect.PresetShape = msoTextEffectShapeCircleCurve
    'myShape.ZOrder msoSendToBack '最背面へ移動
    
    'グループ化
    ActiveSheet.Shapes.SelectAll
    Selection.ShapeRange.Group.Name = "test"
    
End Sub

MSPゴシックを指定しているのに游ゴシックになるのマジ勘弁。
直接編集して変更できたので、とりあえずOK。
本記事トップ画像のように内側に添わせるには、104を87に変更すればできる。

円状に文字を変形すると、文字の数によってフォントサイズが勝手に変更されてしまう模様。Excelの仕様？

そしてこれは多分ワードアートじゃなくても多分大丈夫。エフェクトが気に食わないぞ。

以上。