【Word VBA】五葉線模様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 五葉線模様描画マクロ()

    Const FVLVLEFT = 80　　　     '描画中心位置Ｘ

    Const FVLVTOPP = 80 　　　　'　　　　　　Ｙ

    '

    Const FVLVANSP = 5 　　　　 '描画刻み角度

    Const FVLVRATE = 12 　　　  '線の長さレート

    '

    Const FVLVVPIT = FVLVRATE * 4.2    '横-間隔

    Const FVLVHPIT = FVLVRATE * 4.2    '縦-間隔

    Const FVLVCOLS = 6                        '横/描画数

    Const FVLVROWS = 4                       '縦/描画数

    '

    Const FVLVRAT1 = 1.2                      '大きい倍率

    Const FVLVRAT2 = 0.75                    '小さい倍率

    Const FVLVLNWE = 1                       '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer

    Dim intCxp As Integer, intCyp As Integer

    Dim sngPBas(360 / FVLVANSP, 1) As Single

    Dim sngPDat(360 / FVLVANSP, 1) As Single

    Dim sngSit As Single, sngRpd As Single

    Dim sngRds As Single, lngCol(1) As Long

    Dim sngRat As Single

    '

    '*五葉線曲線ポリラインデータ作成

    sngRpd = Atn(1) / 45

    For Kp = 0 To UBound(sngPBas, 1)

        sngSit = sngRpd * (Kp * FVLVANSP)

        sngRds = 1 + Cos(5 * sngSit)

        sngPBas(Kp, 0) = (sngRds * Cos(sngSit)) * FVLVRATE

        sngPBas(Kp, 1) = (sngRds * Sin(sngSit)) * FVLVRATE

    Next Kp

    '

    lngCol(0) = RGB(205, 92, 92)              '←線色

    lngCol(1) = RGB(154, 205, 50)            '←塗りつぶし

    For Jp = 0 To FVLVROWS - 1

        intCyp = FVLVTOPP + FVLVHPIT * Jp _

                          + FVLVVPIT \ 2

        For Ip = 0 To FVLVCOLS - 1

            intCxp = FVLVLEFT + FVLVVPIT * Ip _

                          + FVLVHPIT \ 2

            sngRat = IIf(((Ip + Jp) Mod 2) = 0, _

                         FVLVRAT1, FVLVRAT2)

            '*ポリライン位置設定

            For Kp = 0 To UBound(sngPBas, 1)

                sngPDat(Kp, 0) = sngPBas(Kp, 0) * sngRat + intCxp

                sngPDat(Kp, 1) = sngPBas(Kp, 1) * sngRat + intCyp

            Next Kp

            '*ポリライン描画

            With ActiveDocument.Shapes.AddPolyline(sngPDat)

                .Fill.Visible = msoTrue

                .Fill.ForeColor = lngCol(1)           '←塗りつぶし

                .Line.Visible = msoTrue

                .Line.ForeColor = lngCol(0)         '←線色

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

                .Rotation = 45 * (Ip + Jp)          '←図形の回転

            End With

        Next Ip

    Next Jp

End Sub