Excel VBA 数字のオートシェイプを作る

色々悔いが残るサンプル

出現する位置がバラバラ

作る位置を統一していなかったので、バラバラに出現する
標準だとA列からAE列
行は1行目から54行目。

大きさもバラバラ

マウスで作っているので、大きさは調整

運用もバラバラ

大きさは適当に縮小して使う。角度は回転を使う。

そのばしのぎ

9は6をひっくり返して使う。
8は１シートに一つしか作れない。
これは円を2つ重ねてグループ化するため
このため0は8をつくってから使う。

言い訳

当然描画しなおしたいと思うのだが、塗りつぶしになるには始点と終点が合わないといけない。
これは終点を始点に近づけて、重ね合わせているとしばらくするとなったりする。文字だとわかりづらいが、しばらくやってみるとわかると思う。
作り直しが難しいのも、一筆書きということで、コード上で数値の修正ができないため。少し間違うと始点と終点が一致しない。
このように不格好であるが、サイズは割と自由で、塗りつぶしの色を変えたり、印刷しない設定にしたりできる。詳しくは公式のサイトを見るといいと思う。
通常であればテキストボックスを使うことが前提だと思う。

オートシェイプに数字の形はない

意外なことにオートシェイプに数字の形はない。
アイコンにもない。
今回無理やり作ったもので、仕事で使うのは微妙だが、かといっていちから作るのも大変。
なので、使用は進めない。
また、フリーフォームでは8を作ると一筆書き風になるため作るのが難しい。

クリップアートが廃止

また、マクロでなくても、とは思うのだが、今はクリップアートに登録できない。クリップアートは廃止されてしまった。
このため、テキストボックス以外では画像として保存するか、マクロを組んでおいて数字を作り出すしかないようだ。

図形を追加する
線またはコネクタを描画または削除する
フリーフォーム図形の描画または編集

サンプル

' Excel VBA
' Make Number Figure Shape

Sub Number01()
' Number01 Macro

    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 1601.25, 330)
        .AddNodes msoSegmentLine, msoEditingAuto, 1610.6249606299, 343.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1642.5, 324.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1642.5, 444.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1642.5, 444.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1635, 468.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1659.3749606299, 468.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1659.3749606299, 301.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1601.25, 330
        .ConvertToShape.Select
    End With
End Sub
Sub Number02()
'
' Number02 Macro
'

'
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 1605, 388.1249606299)
        .AddNodes msoSegmentLine, msoEditingAuto, 1621.8749606299, 410.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1644.3749606299, 390
        .AddNodes msoSegmentLine, msoEditingAuto, 1665, 382.5
        .AddNodes msoSegmentLine, msoEditingAuto, 1683.75, 384.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1698.75, 408.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1700.6249606299, 436.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1696.8749606299, 461.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1670.6249606299, 478.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1633.1249606299, 485.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1614.3749606299, 489.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1605, 515.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1788.75, 513.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1783.1249606299, 489.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1728.75, 491.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1713.75, 491.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1725, 474.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1734.3749606299, 436.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1740, 401.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1719.3749606299, 371.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1700.6249606299, 361.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1683.75, 361.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1659.3749606299, 361.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1648.1249606299, 365.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1627.5, 373.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1627.5, 373.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1605, 388.1249606299
        .ConvertToShape.Select
    End With
End Sub
Sub Number3()
'
' Number3 Macro
'

'
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 1816.8749606299, 431.25)
        .AddNodes msoSegmentLine, msoEditingAuto, 1792.5, 412.5
        .AddNodes msoSegmentLine, msoEditingAuto, 1822.5, 390
        .AddNodes msoSegmentLine, msoEditingAuto, 1856.25, 367.5
        .AddNodes msoSegmentLine, msoEditingAuto, 1912.5, 367.5
        .AddNodes msoSegmentLine, msoEditingAuto, 1931.25, 390
        .AddNodes msoSegmentLine, msoEditingAuto, 1946.25, 421.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1953.75, 453.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1925.6249606299, 468.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1890, 481.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1854.3749606299, 481.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1856.25, 500.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1921.8749606299, 498.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1978.1249606299, 517.5
        .AddNodes msoSegmentLine, msoEditingAuto, 2008.1249606299, 570
        .AddNodes msoSegmentLine, msoEditingAuto, 1978.1249606299, 601.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1890, 630
        .AddNodes msoSegmentLine, msoEditingAuto, 1818.75, 620.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1818.75, 596.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1876.8749606299, 600
        .AddNodes msoSegmentLine, msoEditingAuto, 1933.1249606299, 590.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1963.1249606299, 575.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1972.5, 562.5
        .AddNodes msoSegmentLine, msoEditingAuto, 1953.75, 528.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1918.1249606299, 526.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1871.25, 526.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1837.5, 526.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1835.6249606299, 459.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1880.6249606299, 461.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1921.8749606299, 450
        .AddNodes msoSegmentLine, msoEditingAuto, 1933.1249606299, 444.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1940.6249606299, 427.5
        .AddNodes msoSegmentLine, msoEditingAuto, 1923.75, 399.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1893.75, 386.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1863.75, 395.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1843.1249606299, 406.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1822.5, 416.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1816.8749606299, 431.25
        .ConvertToShape.Select
    End With

End Sub
Sub Number04()
'
' Number04 Macro
'

'
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 1625.6249606299, 345)
        .AddNodes msoSegmentLine, msoEditingAuto, 1595.6249606299, 423.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1663.1249606299, 418.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1665, 480
        .AddNodes msoSegmentLine, msoEditingAuto, 1693.1249606299, 480
        .AddNodes msoSegmentLine, msoEditingAuto, 1691.25, 418.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1734.3749606299, 414.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1734.3749606299, 388.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1696.8749606299, 391.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1695, 371.25
        .AddNodes msoSegmentLine, msoEditingAuto, 1661.25, 373.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1663.1249606299, 393.75
        .AddNodes msoSegmentLine, msoEditingAuto, 1633.1249606299, 397.5
        .AddNodes msoSegmentLine, msoEditingAuto, 1674.3749606299, 305.6249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 1644.3749606299, 300
        .AddNodes msoSegmentLine, msoEditingAuto, 1625.6249606299, 345
        .ConvertToShape.Select
    End With
End Sub
Sub Number05()
'
' Number05 Macro
'


    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 1146.9100787402, _
        594.9438582677)
        .AddNodes msoSegmentLine, msoEditingAuto, 1190.7303149606, 594.9438582677
        .AddNodes msoSegmentLine, msoEditingAuto, 1191.5730708661, 605.8988976378
        .AddNodes msoSegmentLine, msoEditingAuto, 1160.3932283465, 605.8988976378
        .AddNodes msoSegmentLine, msoEditingAuto, 1159.5505511811, 626.1236220472
        .AddNodes msoSegmentLine, msoEditingAuto, 1187.3595275591, 627.808976378
        .AddNodes msoSegmentLine, msoEditingAuto, 1194.9438582677, 643.8202362205
        .AddNodes msoSegmentLine, msoEditingAuto, 1193.2584251969, 657.3033858268
        .AddNodes msoSegmentLine, msoEditingAuto, 1155.3370866142, 658.1460629921
        .AddNodes msoSegmentLine, msoEditingAuto, 1152.808976378, 658.1460629921
        .AddNodes msoSegmentLine, msoEditingAuto, 1154.4944094488, 648.0337007874
        .AddNodes msoSegmentLine, msoEditingAuto, 1183.1460629921, 648.0337007874
        .AddNodes msoSegmentLine, msoEditingAuto, 1183.1460629921, 640.4494488189
        .AddNodes msoSegmentLine, msoEditingAuto, 1178.0899212598, 637.0786614173
        .AddNodes msoSegmentLine, msoEditingAuto, 1154.4944094488, 636.235984252
        .AddNodes msoSegmentLine, msoEditingAuto, 1153.6516535433, 636.235984252
        .AddNodes msoSegmentLine, msoEditingAuto, 1151.9662992126, 636.235984252
        .AddNodes msoSegmentLine, msoEditingAuto, 1146.9100787402, 594.9438582677
        .ConvertToShape.Select
    End With
End Sub
Sub Number06()
'
' Number06 Macro
'

'
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 45.5357480315, _
        192.8571653543)
        .AddNodes msoSegmentLine, msoEditingAuto, 72.3214173228, 192.8571653543
        .AddNodes msoSegmentLine, msoEditingAuto, 72.3214173228, 254.4642519685
        .AddNodes msoSegmentLine, msoEditingAuto, 128.5714173228, 254.4642519685
        .AddNodes msoSegmentLine, msoEditingAuto, 127.2321259843, 328.1249606299
        .AddNodes msoSegmentLine, msoEditingAuto, 44.1964566929, 326.7857480315
        .AddNodes msoSegmentLine, msoEditingAuto, 46.8749606299, 308.0357480315
        .AddNodes msoSegmentLine, msoEditingAuto, 108.4821259843, 309.3749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 107.1428346457, 279.9107086614
        .AddNodes msoSegmentLine, msoEditingAuto, 72.3214173228, 279.9107086614
        .AddNodes msoSegmentLine, msoEditingAuto, 69.6428346457, 305.3571653543
        .AddNodes msoSegmentLine, msoEditingAuto, 48.2142519685, 301.3392913386
        .AddNodes msoSegmentLine, msoEditingAuto, 45.5357480315, 192.8571653543
        .ConvertToShape.Select
    End With
    Selection.ShapeRange.ScaleWidth 0.9523816634, msoFalse, msoScaleFromBottomRight
    Selection.ShapeRange.ScaleHeight 0.9207922925, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleWidth 0.733333268, msoFalse, msoScaleFromBottomRight
    Selection.ShapeRange.ScaleHeight 0.4623651088, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleWidth 0.7954563979, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.9302349111, msoFalse, _
        msoScaleFromBottomRight
End Sub
Sub Number07()
'
' Number07 Macro
'

'
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 50.8928346457, _
        218.3035433071)
        .AddNodes msoSegmentLine, msoEditingAuto, 73.6607086614, 220.9821259843
        .AddNodes msoSegmentLine, msoEditingAuto, 72.3214173228, 203.5714173228
        .AddNodes msoSegmentLine, msoEditingAuto, 105.8035433071, 207.5892913386
        .AddNodes msoSegmentLine, msoEditingAuto, 104.4642519685, 278.5714173228
        .AddNodes msoSegmentLine, msoEditingAuto, 124.5535433071, 281.25
        .AddNodes msoSegmentLine, msoEditingAuto, 124.5535433071, 198.2142519685
        .AddNodes msoSegmentLine, msoEditingAuto, 61.6071653543, 196.8749606299
        .AddNodes msoSegmentLine, msoEditingAuto, 50.8928346457, 218.3035433071
        .ConvertToShape.Select
    End With

    Selection.ShapeRange.ScaleWidth 0.9090915893, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.841270182, msoFalse, msoScaleFromTopLeft
End Sub
Sub Number08Form()
'
' Number08Form Macro
'
Dim shps As Excel.Shapes, shp As Excel.Shape, shpr As Excel.ShapeRange, buf1 As String, buf2 As String
    ActiveSheet.Shapes.AddShape(msoShapeDonut, 81.6964566929, 171.4285826772, _
        52.2321259843, 42.8571653543).Select
    ActiveSheet.Shapes.AddShape(msoShapeDonut, 89.7321259843, 216.9642519685, _
        60.2678740157, 65.6250393701).Select
    Selection.ShapeRange.IncrementLeft -12.0535433071
    Selection.ShapeRange.IncrementTop -5.3571653543
For Each shp In ActiveSheet.Shapes
If shp.Name Like ("Donut*") Then
If buf1 = "" Then
buf1 = shp.Name
ElseIf buf2 = "" Then
buf2 = shp.Name
End If
End If
Next
    ActiveSheet.Shapes.Range(Array(buf1, buf2)).Select
    Selection.ShapeRange.Group.Select
End Sub