正多角形のオートシェイプを作成する PowerPoint のマクロ

'
' DrawPolygon
' 正多角形のオートシェイプを作成する
'
' angle:  角の数
' radius: 半径 (px)
' lines:  中心から各頂点までの線を引くかどうか - 規定値 True (引く)
' orig_x: 画面上での原点 X (px) - 規定値 360px
' orig_y: 画面上での原点 Y (px) - 規定値 270px
'
Public Sub DrawPolygon(angle As Long, radius As Single, Optional lines As Boolean = True, _
                       Optional orig_x As Single = 360#, Optional orig_y As Single = 270#)
    
    Const PI As Single = 3.1415926535 ' 円周率
    
    Dim x()  As Single
    Dim y()  As Single
    Dim Sp   As Shapes
    Dim i As Long
    
    ReDim x(angle)
    ReDim y(angle)
    
    ' 各角の座標の決定
    For i = 0 To angle - 1
        x(i) = orig_x + Cos(2 * PI * i / angle) * radius
        y(i) = orig_y - Sin(2 * PI * i / angle) * radius
    Next
    
    Set Sp = ActiveWindow.Selection.SlideRange.Shapes
    
    ' 多角形を作成
    With Sp.BuildFreeform(msoEditingAuto, x(angle - 1), y(angle - 1))
        For i = 0 To angle - 1
            .AddNodes msoSegmentLine, msoEditingAuto, x(i), y(i)
        Next
        .ConvertToShape.Fill.Visible = msoFalse
    End With
    
    If lines Then
        ' 中心から頂点までの線をひく
        For i = 0 To angle - 1
            Sp.addLine orig_x, orig_y, x(i), y(i)
        Next
    End If
    
End Sub