【Word VBA】ルート長方形描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub ルート長方形描画マクロ()

    Const ROOTWLFT = 100                     '描画開始位置Ｘ

    Const ROOTWTOP = 100                    '　　　　　　Ｙ

    Const ROOTWLNG = 250                    '最初の対角線長

    Const ROOTWCNT = 7                       '対角線数

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

    Dim Ip As Integer, dblRd As Double, intLng As Integer

    Dim dblDr As Double,  intXp(2) As Integer, intYp(2) As Integer

    '

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

    intXp(0) = ROOTWLFT: intYp(0) = ROOTWTOP

    intLng = ROOTWLNG: dblDr = 54.7

    '

    For Ip = 0 To ROOTWCNT - 1

        intXp(1) = intXp(0) + CInt(intLng * Cos(dblDr * dblRd))

        intYp(1) = intYp(0) + CInt(intLng * Sin(dblDr * dblRd))

        '*対角線描画

        With ActiveDocument.Shapes.AddLine( _

                  intXp(0), intYp(0), intXp(1), intYp(1)).Line

             .ForeColor.RGB = vbMagenta                              '←線色

        End With

        '*長方形描画

        intXp(2) = IIf(intXp(0) < intXp(1), intXp(0), intXp(1))

        intYp(2) = IIf(intYp(0) < intYp(1), intYp(0), intYp(1))

        With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _

             intXp(2), intYp(2), Abs(intXp(0) - intXp(1)), _

                                 Abs(intYp(0) - intYp(1)))

            .Fill.Visible = False

            .Line.Visible = True

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

        End With

        '

        intXp(0) = intXp(1): intYp(0) = intYp(1)

        intLng = CInt(intLng / Sqr(2))

        dblDr = dblDr - 90

    Next Ip

End Sub