【Word VBA】楕円状に並べた楕円形描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 楕円状に並べた楕円形描画マクロ()

    Const ELLICXPS = 200               '輪の中心位置Ｘ

    Const ELLICYPS = 160               '                  Ｙ

    '

    Const ELLISCNT = 15                 '楕円の数

    Const ELLISRAD = 16                 '楕円の半径

    '

    Const ELLIMRAD = 100              '輪の半径

    '

    Const ELLIRATE = 0.5               '楕円のＹ／Ｘ

    '

    Const ELLILNWT = 1                '輪郭線の太さ

    '---------------------------------------------------------------------------

    Dim Ip As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim intEwd As Integer, intEht As Integer

    Dim sngAng As Single, lngCol(1) As Long

    '

    lngCol(0) = vbBlack 　　　　　　'←輪郭線の色

    lngCol(1) = RGB(148, 0, 211) 　'←塗りつぶし色

    '

    sngAng = ((4 * Atn(1)) / 180) * (360 \ ELLISCNT)

    intEwd = ELLISRAD * 2: intEht = CInt(intEwd * ELLIRATE)

    For Ip = 0 To ELLISCNT - 1

        intDxp = ELLIMRAD * Cos(sngAng * Ip) + ELLICXPS

        intDyp = ELLIMRAD * Sin(sngAng * Ip) * ELLIRATE + ELLICYPS

        '

         With ActiveDocument.Shapes.AddShape(msoShapeOval, _

              intDxp - intEwd / 2, intDyp - intEht / 2, _

              intEwd, intEht)

             .Line.Visible = True　　　                  '←線の有無

             .Line.ForeColor.RGB = lngCol(0)　　  '←線色

             .Line.Weight = ELLILNWT　　           '←線の太さ

             .Fill.Visible = True　　　　                '←塗りつぶし有無

             .Fill.ForeColor.RGB = lngCol(1)　      '←塗りつぶし色

             '

             .Rotation = (360 \ ELLISCNT) * Ip　'←回転角

         End With

    Next Ip

End Sub