【Word VBA】小桜文様描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub 小桜文様描画マクロ()

    Const SCHELEFT = 80　　　         '描画開始位置Ｘ

    Const SCHETOPP = 100 　　　　  '　　　　　　Ｙ

    '

    Const SCHEPRAD = 12                '花びら中心半径

    Const SCHEPWID = 12                '花びら幅

    Const SCHEPHEI = 16                 '花びら高さ

    '

    Const SCHEROWS = 4　　　         '描画数(縦)

    Const SCHECOLS = 6 　　　　　　'描画数(横)

    Const SCHEROLN = 45　　　        '縦方向間隔

    Const SCHECOLN = 55 　　　　　 '横方向間隔

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

    Dim Ip As Integer, Jp As Integer, Kp As Integer

    Dim intCxp As Integer, intCyp As Integer

    Dim intPxp As Integer, intPyp As Integer

    Dim lngCol(1) As Long, dblRva As Double

    '

    lngCol(0) = RGB(255, 105, 180)         '←塗りつぶし色(ピンク)

    lngCol(1) = vbBlack                           '←線色

    dblRva = ((4 * Atn(1)) / 180) * (360 / 5)

    For Jp = 0 To SCHEROWS - 1

        intCyp = SCHETOPP + SCHEROLN * Jp

        For Ip = 0 To SCHECOLS - 1 - (Jp Mod 2)

            intCxp = SCHELEFT + SCHECOLN * Ip  _

                                         + (SCHECOLN * (Jp Mod 2)) \ 2

            For Kp = 0 To 4

                intPxp = SCHEPRAD * Cos(dblRva * Kp) + intCxp

                intPyp = SCHEPRAD * Sin(dblRva * Kp) + intCyp

                '*花びら描画（ハート図形を代用）

                With ActiveDocument.Shapes.AddShape(msoShapeHeart, _

                           intPxp - SCHEPWID \ 2, intPyp - SCHEPHEI \ 2, _

                           SCHEPWID, SCHEPHEI)

                    .Fill.ForeColor.RGB = lngCol(0)      '←塗りつぶし色

                    .Fill.Visible = True

                    .Line.ForeColor.RGB = lngCol(1)    '←線色

                    .Line.Visible = True

                    .Rotation = 72 * Kp + 90              '←傾き

                End With

            Next Kp

        Next Ip

    Next Jp

End Sub

蛇足

　「桜は日本人の心」ということで、桜の花びらをベジェ曲線ではなく、あえてハート図形で描画してみた。

　にしても、今の日本のリーダーに、桜のように潔い人はいなくなったと思う、今日この頃。