【Word VBA】カラフル曲線描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub カラフル曲線描画マクロ()

    Const COLFCNXP = 160　　　　    '描画中心位置Ｘ

    Const COLFCNYP = 160 　　　　　'　　　　　　Ｙ

    '

    Const COLFANSP = 5 　　　　　　'描画刻み角度

    Const COLFNPRD = 360 / COLFANSP　 '一周の点数

    Const COLFRATE = 45　　　　     '線の長さレート

    Const COLFRAND = 8　　　　      '周回数

    '

    Const COLFLNWE = 3.5　　　　  '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer

    Dim sngPDat(COLFNPRD, 1) As Single

    Dim sngSit As Single, sngRpd As Single

    Dim sngRds As Single, lngCol As Long

    '

    sngRpd = Atn(1) / 45

    For Jp = 0 To COLFRAND - 1

        '*ポリラインデータ作成

        For Ip = 0 To UBound(sngPDat, 1)

            Kp = COLFNPRD * Jp + Ip

            sngSit = sngRpd * (Kp * COLFANSP)

            sngRds = 1 + Cos(7 / 8 * sngSit)

            sngPDat(Ip, 0) = (sngRds * Cos(sngSit)) _

                           * COLFRATE + COLFCNXP

            sngPDat(Ip, 1) = (sngRds * Sin(sngSit)) _

                           * COLFRATE + COLFCNYP

        Next Ip

        '*描画線色選択

        lngCol = Choose((Jp Mod 6) + 1, _

                 RGB(138, 43, 226), RGB(0, 191, 255), _

                 RGB(255, 165, 0), RGB(128, 0, 128), _

                 RGB(255, 20, 147), RGB(255, 127, 80))

        '*ポリライン描画

        With ActiveDocument.Shapes.AddPolyline(sngPDat)

            .Fill.Visible = msoFalse

            .Line.Visible = msoTrue

            .Line.ForeColor = lngCol 　　　'←線色

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

        End With

    Next Jp

End Sub