Excel VBAで図形（オートシェイプ）を簡単に作成する方法：三角くじを作ってみよう - Step2

'作成開始ボタン
Private Sub CommandButton1_Click()
    Dim ln1 As Long
    Dim ln2 As Long
    
    ln1 = MyGetSuchi("C2")
    If ln1 <= 0 Or ln1 > 100 Then
        MsgBox "くじ枚数は1～100の範囲で入力してください。"
        Exit Sub
    End If
    
    ln2 = MyGetSuchi("C3")
    If ln2 < 0 Or ln2 > ln1 Then
        MsgBox "当たり枚数は,くじ枚数より少なくしてください。"
        Exit Sub
    End If
    
    Range("C2") = ln1
    Range("C3") = ln2
    
    ExMakeShape
End Sub

下記のVBAコードを追加してください。

Sub ExMakeShape()
    Dim tshape As Shape
    
    Set tshape = Sheets("くじ引き").Shapes.AddShape(Type:=msoShapeIsoscelesTriangle, Left:=0, Top:=0, Width:=216, Height:=94.5)

    '塗りつぶし
    tshape.Fill.Visible = True
    '透明度
    tshape.Fill.Transparency = 0.5
    '塗りつぶし色
    tshape.Fill.ForeColor.RGB = vbRed
    
    
    '文字をセット
    tshape.TextFrame.Characters.Text = "三角くじ"
    '文字色
    tshape.TextFrame.Characters.Font.ColorIndex = 0
    '太字
    tshape.TextFrame.Characters.Font.Bold = True
    'サイズ
    tshape.TextFrame.Characters.Font.Size = 16
    '中央に表示
    tshape.TextFrame.HorizontalAlignment = xlCenter
    '選択
    tshape.Select
    'コピー
    tshape.Copy
    '削除
    tshape.Delete
    Set tshape = Nothing
End Sub