【Word VBA】回転する長方形描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub 回転する長方形描画マクロ()

    Const RECTCXPS = 180                              '描画の中心位置　X

    Const RECTCYPS = 150                              '                        Y

    Const RECTWIDT = 80                               '長方形の幅

    Const RECTHEIG = 150                              '長方形の高さ

    '

    Const RECTCONT = 10                              '長方形の数/一周

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

    Dim Ip As Integer, intAng As Integer, dblRd As Double

    Dim intXp As Integer, intYp As Integer

    Dim intWd As Integer, intHt As Integer

    Dim intXa As Integer, intYa As Integer, varCl As Variant

    '

    'カラーデータ//////////////////////////////////////////////////////////////

    varCl = Array(0, 16777215, 255, 65280, 16711680, 65535, _

    16711935, 16776960, 128, 32768, 8388608, 32896, 8388736, _

    8421376, 12632256, 8421504, 16751001, 6697881)

    '

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

    intWd = RECTWIDT: intHt = RECTHEIG

    For Ip = 0 To RECTCONT - 1

        intXa = intWd \ 2: intYa = intHt \ 2

        intAng = (360 / RECTCONT) * Ip

        intXp = intXa * Cos(dblRd * intAng) - _

                    intYa * Sin(dblRd * intAng) + RECTCXPS

        intYp = intXa * Sin(dblRd * intAng) + _

                    intYa * Cos(dblRd * intAng) + RECTCYPS

        With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _

             intXp - intXa, intYp - intYa, intWd, intHt)

            .Fill.ForeColor.RGB = varCl(Ip + 2)        '←塗りつぶし色

            .Fill.Visible = True

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

            .Line.Visible = True

            .Rotation = intAng

        End With

        intWd = intWd * 0.8: intHt = intHt * 0.8

    Next Ip

End Sub

                 .Fill.Visible = False

   '    intWd = intWd * 0.8: intHt = intHt * 0.8    '(コメントにして無効に)