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

Option Explicit

Option Base 0

Public Sub 回転する四角形描画マクロ()

    Const RECTLEFT = 100 　　　　　　'描画の開始位置　X

    Const RECTTOPP = 80 　　　　　　 ' 　                    Y

    Const RECTLENG = 200                  '四角形(外側)の一辺の長さ

    Const RECTSTPP = 0.9                   '四角形の縮小率

    Const RECTANGL = 7                     '四角形の角度

    Const RECTCONT = 25              　  '四角形の数

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

    Dim Ip As Integer, intLng As Integer

    Dim intCXp As Integer, intCYp As Integer

    '

    intLng = RECTLENG \ 2

    intCXp = RECTLEFT + intLng

    intCYp = RECTTOPP + intLng

    For Ip = 0 To RECTCONT - 1

        With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _

             intCXp - intLng, intCYp - intLng, intLng * 2, intLng * 2)

            .Fill.Visible = False

            .Line.Visible = True

            .Line.ForeColor.RGB = RGB(128, 128, 0) 　'←線色(Olive

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

            .Rotation = RECTANGL * Ip                      '←回転角

        End With

        intLng = intLng * RECTSTPP

    Next Ip

End Sub