【Word VBA】いちょう葉描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub いちょう葉描画マクロ()

    Const GINKLEFT = 100　　　　'描画開始位置Ｘ

    Const GINKTOPP = 100　　　　'　　　　　　Ｙ

    '

    Const GINKBZMG = 0.25　　　'ベジェ曲線描画倍率

    '

    Const GINKBWID = 152.9 * GINKBZMG 　　'描画幅

    Const GINKBHEI = 184.54 * GINKBZMG　　'描画高さ

    Const GINKVPIT = (GINKBWID + 5)　　　　'横-間隔

    Const GINKHPIT = (GINKBHEI + 5)　　　　'縦-間隔

    '

    Const GINKCOLS = 6　　　　　　　　'横/描画数

    Const GINKROWS = 4　　　　　　　　'縦/描画数

    '

    Const GINKLNWE = 1　　　　　　　　'線の太さ

    Const GINKWAVE = 20　　　　　　　　'揺れ角

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim lngCol(2) As Long

    Dim sngBBas() As Single, sngBDat() As Single

    Dim varBezi As Variant

    '

    '*ベジェ曲線データ

    varBezi = Array(-2.31, -65.47, -3.25, -66.83, -5.12, -76.13, -6.85, -79.92, -8.59, -83.71, -10.15, -86.67, -12.74, -88.21, -15.34, -89.76, -18.81, -89.17, -22.43, -89.17, -26.05, -89.18, -30.77, -89.66, -34.47, -88.26, -38.17, -86.87, -40.85, -83.51, -44.64, -80.78, -48.42, -78.05, -53.16, -75.4, -57.16, -71.89, -61.17, -68.38, -65.55, -64.6, -68.67, -59.74, -71.79, -54.88, -76.45, -47.35, -75.9, -42.72, -75.34, -38.09, -71.63, -34.46, -65.35, -31.96, -59.08, -29.47, -47.48, -29.91, -38.25, -27.74, -29.01, -25.57, -17.13, -20.96, -11.25, -18.73, -5.36, -16.5, -5.24, -14.48, -2.94, -11.14, _

-0.65, -7.8, 1.45, -6.98, 2.51, 1.33, 3.57, 9.64, 3.74, 22.81, 3.43, 38.73, 3.11, 54.65, 2.23, 70.98, 1.92, 79.08, 1.62, 87.17, 1.22, 85.78, 1.6, 87.3, 0.92, 91.61, 2.9, 92.27, 3.37, 91.6, 3.83, 90.92, 4.33, 85.74, 4.39, 83.25, 4.46, 80.77, 5.42, 74.13, 5.46, 71.02, 5.49, 67.91, 5.88, 66.36, 6.1, 57.52, 6.32, 48.69, 6.71, 27.93, 6.79, 18.02, 6.87, 8.12, 6.09, 3.51, 6.58, -1.89, 7.07, -7.28, 6.69, -10.75, 9.74, -14.36, 12.79, -17.96, 19.74, -21.35, 24.88, -23.51, 30.02, -25.67, 36.12, -26.48, 40.59, -27.31, 45.07, -28.15, 48.27, -28.06, 51.75, -28.54, 55.23, -29.02, 58.28, -29.53, _

61.48, -30.2, 64.68, -30.86, 68.56, -30.69, 70.96, -32.55, 73.36, -34.4, 75.27, -38.41, 75.86, -41.33, 76.45, -44.25, 75.66, -47.35, 74.49, -50.05, 73.33, -52.75, 70.7, -55.09, 68.87, -57.52, 67.05, -59.96, 65.66, -60.77, 63.74, -62.95, 61.82, -65.13, 60.38, -68.06, 57.35, -70.59, 54.31, -73.11, 50.4, -75.34, 45.54, -78.1, 40.68, -80.86, 33.99, -84.79, 28.2, -87.14, 22.41, -89.5, 15.4, -92.18, 10.81, -92.23, 6.21, -92.27, 2.78, -90.75, 0.64, -87.41, -1.5, -84.06, -0.73, -75.07, -1.18, -71.73, -1.63, -68.38, -1.36, -64.1, -2.31, -65.47)

    '*ベジェ曲線データ設定

    ReDim sngBBas((UBound(varBezi, 1) - 1) \ 2, 1)

    ReDim sngBDat((UBound(varBezi, 1) - 1) \ 2, 1)

    For Kp = LBound(sngBBas, 1) To UBound(sngBBas, 1)

        sngBBas(Kp, 0) = CSng(varBezi(Kp * 2 + 0)) * GINKBZMG

        sngBBas(Kp, 1) = CSng(varBezi(Kp * 2 + 1)) * GINKBZMG

    Next Kp

    '

    Randomize　                               '←乱数系列初期化

    '

    lngCol(0) = vbBlack　                  '←線色

    lngCol(1) = vbYellow 　　　　　　'←塗りつぶし色１

    lngCol(2) = RGB(34, 139, 34) 　  '←塗りつぶし色２

    '

    For Jp = 0 To GINKROWS - 1

        intDyp = GINKTOPP + GINKHPIT * Jp + GINKBHEI / 2

        For Ip = 0 To GINKCOLS - 1

            intDxp = GINKLEFT + GINKVPIT * Ip + GINKBWID / 2

            '*いちょうベジェ曲線位置設定

            For Kp = LBound(sngBDat, 1) To UBound(sngBDat, 1)

                sngBDat(Kp, 0) = sngBBas(Kp, 0) + intDxp

                sngBDat(Kp, 1) = sngBBas(Kp, 1) + intDyp

            Next Kp

            '*いちょうベジェ曲線描画

            With ActiveDocument.Shapes.AddCurve(sngBDat)

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

                .Fill.ForeColor.RGB = _

                     lngCol(1 + (Jp + Ip) Mod 2)         '←塗りつぶし

                .Line.Weight = GINKLNWE '

                .Rotation = _

                CInt(Rnd * GINKWAVE) - (GINKWAVE / 2)        '←回転角

            End With

        Next Ip

    Next Jp

End Sub