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

Option Explicit

Option Base 0

'

Public Sub 松葉文様描画マクロ()

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

    Const PINETOPP = 100            '　　　　　　Ｙ

    '

    Const PINEVSPC = 25              '横-間隔

    Const PINEHSPC = 30              '縦-間隔

    Const PINECOLS = 10              '横/描画数

    Const PINEROWS = 5              '縦/描画数

    '

    Const PINEBZMG = 2               'ベジェ設定倍率

    Const PINELFLN = 40               '松葉の長さ

    Const PINELFOP = 10              '松葉の開き

    Const PINELFWT = 2.5            '松葉の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, lngCol(1) As Long

    Dim intDxp As Integer, intDyp As Integer

    Dim sngBBs(9, 1) As Single, sngBDt(9, 1) As Single

    Dim sngPol(2, 1) As Single

    Dim varBez As Variant, varNam(1) As Variant

    '

    '鎹(かすがい)部分ベジェデータ

    varBez = Array(0#, 3.36, 1.62, 2.62, 0.42, 1.3, 2.44, 1.3, _

    1.72, -0.64, -1.94, -0.68, -2.44, 1.26, -0.5, 1.3, -1.64, _

    2.6, 0#, 3.36)

    '鎹部分ベジェデータ設定

    For Ip = LBound(sngBBs, 1) To UBound(sngBBs, 1)

        sngBBs(Ip, 0) = CSng(varBez(Ip * 2 + 0)) * PINEBZMG

        sngBBs(Ip, 1) = CSng(varBez(Ip * 2 + 1)) * PINEBZMG * -1

    Next Ip

    '

    Randomize                                  '*乱数系列初期化

    '

    lngCol(0) = RGB(0, 100, 0)          '葉の色

    lngCol(1) = RGB(165, 42, 42)      '鎹の色

    For Jp = 0 To PINEROWS - 1

        intDyp = PINETOPP + PINEHSPC * Jp

        For Ip = 0 To PINECOLS - 1

            intDxp = PINELEFT + PINEVSPC * Ip

            '*松葉部分位置設定

            sngPol(1, 0) = intDxp: sngPol(1, 1) = intDyp - 1

            sngPol(0, 0) = intDxp - PINELFOP

            sngPol(0, 1) = intDyp + PINELFLN

            sngPol(2, 0) = intDxp + PINELFOP

            sngPol(2, 1) = intDyp + PINELFLN

            '*松葉部分描画

            With ActiveDocument.Shapes.AddPolyline(sngPol)

                .Fill.Visible = msoFalse

                .Line.Visible = msoTrue

                .Line.ForeColor = lngCol(0)

                .Line.Weight = PINELFWT

                varNam(0) = .Name

           End With

           '*鎹部分位置設定

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

               sngBDt(Kp, 0) = sngBBs(Kp, 0) + intDxp

               sngBDt(Kp, 1) = sngBBs(Kp, 1) + intDyp

           Next Kp

           '*鎹部分描画

           With ActiveDocument.Shapes.AddCurve(sngBDt)

               .Fill.Visible = msoTrue

               .Fill.ForeColor = lngCol(1)

               .Line.Visible = msoFalse

               varNam(1) = .Name

           End With

           '*グループ化＆回転（回転角は乱数による）

           Kp = CInt(Rnd * 180) * 2

 ActiveDocument.Shapes.Range(varNam).Group.Rotation = Kp

        Next Ip

    Next Jp

    '*グループ化による選択解除

    Selection.Collapse Direction:=wdCollapseEnd

End Sub