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

Option Explicit

Option Base 0

Public Sub 桔梗文様描画マクロ() 

    Const KIKYLEFT = 150　　 　　      '描画開始位置Ｘ

    Const KIKYTOPP = 120 　　  　　　'　　　　　　Ｙ

    '

    Const KIKYPRAD = 14 　　　　　　'花半径（花びら）

    Const KIKYSRAD = 10                   '花半径 (／)

    Const KIKYMRAD = 4                    '花半径（○）

    '

    Const KIKYROWS = 3                   '描画数(行)

    Const KIKYCOLS = 4                    '描画数(桁)

    Const KIKYROLN = 50                  '縦方向間隔

    Const KIKYCOLN = 60                  '横方向間隔

    '

    Const KIKYLNWE = 1                   '描画線の太さ

    '

    Const KIKYADJU = 13 　　　　　  '調整値

    Const KIKYBZXX = 0.15               'ベジェ曲線描画倍率

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, Lp As Integer

    Dim intCxp As Integer, intCyp As Integer

    Dim intPxp As Integer, intPyp As Integer

    Dim lngCol As Long, dblRva As Double

    Dim varBez As Variant, sngBez(6, 1) As Single

    '

    lngCol = RGB(138, 43, 226)                         '←描画色

    dblRva = ((4 * Atn(1)) / 180) * (360 / 5)      '←72度

    'ベジェ曲線の元データ（７点）

    varBez = Array(0, 0, 110, -109, 88, -129, -1, _

                  -172, -91, -130, -111, -105, 0, 0)

    '

    For Jp = 0 To KIKYROWS - 1

        intCyp = KIKYTOPP + KIKYROLN * Jp

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

            intCxp = KIKYTOPP + KIKYCOLN * Ip  _

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

            '

            For Kp = 0 To 4

              intPxp = KIKYPRAD * Cos(dblRva * Kp - dblRva / 4) + intCxp

                intPyp = KIKYPRAD * Sin(dblRva * Kp - dblRva / 4) + intCyp

                '花びらをベジェ曲線で描画

                For Lp = LBound(sngBez, 1) To UBound(sngBez, 1)

                    sngBez(Lp, 0) = CSng(varBez(Lp * 2 + 0))  _

                                           * KIKYBZXX + intPxp

                    sngBez(Lp, 1) = CSng(varBez(Lp * 2 + 1))  _

                                           * KIKYBZXX + intPyp

                Next Lp

                '*ベジェ曲線描画

                With ActiveDocument.Shapes.AddCurve(sngBez)

                     .Fill.Visible = True                 '←塗りつぶし有無

                .Fill.ForeColor.RGB = IIf((Jp Mod 2) = 0, vbWhite, lngCol)

                .Line.Visible = True                    '←線の有無

                .Line.ForeColor.RGB = IIf((Jp Mod 2) = 0, lngCol, vbWhite)

                .Line.Weight = KIKYLNWE

                .Rotation = 72 * Kp + 72

                End With

                '*線描画

              intPxp = KIKYSRAD * Cos(dblRva * Kp - dblRva / 4) + intCxp

                intPyp = KIKYSRAD * Sin(dblRva * Kp - dblRva / 4) + intCyp

     With ActiveDocument.Shapes.AddLine(intCxp, intCyp - KIKYADJU, _

                     intPxp, intPyp - KIKYADJU).Line

                     .ForeColor.RGB = IIf((Jp Mod 2) = 0, lngCol, vbWhite)

                     .Weight = KIKYLNWE

                End With

            Next Kp

           '*真ん中○部分描画

            With ActiveDocument.Shapes.AddShape(msoShapeOval, _

                  intCxp - KIKYMRAD, intCyp - KIKYMRAD - KIKYADJU, _

                          KIKYMRAD * 2, KIKYMRAD * 2)

                .Fill.Visible = True                        '←塗りつぶし有無

                .Fill.ForeColor = IIf((Jp Mod 2) = 0, vbWhite, lngCol)

                .Line.ForeColor.RGB = IIf((Jp Mod 2) = 0, lngCol, vbWhite)

                .Line.Visible = True                      '←線の有無

                .Line.Weight = KIKYLNWE

           End With

        Next Ip

    Next Jp

End Sub

蛇足

　ベジエ曲線のデータを作成するために、ツールをVB.NET(2019)で作った。

見ての通り、未完だけど。