【Word VBA】丸く並ぶ円描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub 丸く並ぶ円描画マクロ()

    Const CIRCXPOS = 200              '輪の中心位置　X

    Const CIRCYPOS = 160               '                    Y

    Const CIRCRADI = 100               '輪の半径

    '

    Const SATECONT = 12               '円の数

    Const SATERADI = 25                '円の半径

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

    Dim Ip As Integer, intAng As Integer

    Dim intXp As Integer, intYp As Integer, dblRd As Double

    '

    dblRd = (4 * Atn(1)) / 180

    intAng = 360 \ SATECONT

    For Ip = 0 To SATECONT - 1

        intXp = CIRCRADI * Cos(dblRd * (intAng * Ip)) + CIRCXPOS

        intYp = CIRCRADI * Sin(dblRd * (intAng * Ip)) + CIRCYPOS

'

        With ActiveDocument.Shapes.AddShape(msoShapeOval, _

                           intXp - SATERADI, intYp - SATERADI, _

                                   SATERADI * 2, SATERADI * 2)

               .Fill.ForeColor.RGB = vbCyan             '←塗りつぶし色

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

               .Line.ForeColor.RGB = vbBlue           '←線色

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

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

         End With

    Next Ip

End Sub

          Const SATECONT = 5                   '円の数

          Const SATERADI = 40                  '円の半径

          Const SATECONT = 24               '円の数

          Const SATERADI = 10                '円の半径

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

              Const CIRCRADI = 70                    '輪の半径

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

              Const CIRCRADI = 570                        '輪の半径

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

Public Sub 丸く並ぶ円描画マクロ2()

    Const CIRCXPOS = 200 '輪の中心位置　X

    Const CIRCYPOS = 160 ' Y

    Const CIRCRADI = 100 '輪の半径

    '

    Const SATECONT = 12 '円の数

    Const SATERAD1 = 25 '円の半径(1)

    Const SATERAD2 = 15 '円の半径(2)

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

    Dim Ip As Integer, intAng As Integer

    Dim intXp As Integer, intYp As Integer, dblRd As Double

    Dim intRa As Integer

    '

    dblRd = (4 * Atn(1)) / 180

    intAng = 360 \ SATECONT

    For Ip = 0 To SATECONT - 1

        intXp = CIRCRADI * Cos(dblRd * (intAng * Ip)) + CIRCXPOS

        intYp = CIRCRADI * Sin(dblRd * (intAng * Ip)) + CIRCYPOS

        intRa = IIf((Ip Mod 2) = 0, SATERAD1, SATERAD2)              '<<

'

        With ActiveDocument.Shapes.AddShape(msoShapeOval, _

                           intXp - intRa, intYp - intRa, _

                                   intRa * 2, intRa * 2)

               .Fill.ForeColor.RGB = vbCyan '←塗りつぶし色

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

               .Line.ForeColor.RGB = vbBlue '←線色

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

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

         End With

    Next Ip

End Sub