【Word VBA】ルーローの三角形描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub ルーローの三角形描画マクロ() 

    Const REULCXP = 200 　　　　　　　　　　　　'中心位置Ｘ

    Const REULCYP = 180 　　　　　　　　　　　　'　　　　Ｙ

    Const REULRAD = 80　　　　　　　　　　        '頂点までの距離

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

    Dim Ip As Integer, Jp As Integer, dblRd As Double

    Dim intXp As Integer, intYp As Integer, intRd As Integer

    '

    dblRd = (4 * Atn(1)) / 180: intRd = CInt(REULRAD * Sqr(3))

    For Ip = 0 To 2

        intXp = CInt(REULCXP + REULRAD * Sin(dblRd * 120 * Ip))

        intYp = CInt(REULCYP - REULRAD * Cos(dblRd * 120 * Ip))

        With ActiveDocument.Shapes.AddShape(msoShapeArc, _

             intXp - intRd, intYp - intRd, intRd * 2, intRd * 2)

                .Line.Visible = True

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

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

                '

                .Adjustments(1) = Choose(Ip + 1, 60, 180, 300)

                .Adjustments(2) = Choose(Ip + 1, 120, 240, 360)

         End With

    Next Ip

End Sub