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

Option Explicit

Option Base 0

'

Public Sub 山路文様描画マクロ()

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

    Const MTRDTOPP = 90 　　  '　　　　　　Ｙ

    '

    Const MTRDSWID = 30        '描画幅

    Const MTRDSHEI = 12         '描画高さ

    '

    Const MTRDHSPC = 12        '縦-間隔

    Const MTRDCOLS = 8          '横/山の数

    Const MTRDROWS = 12       '縦/描画数

    '

    Const MTRDLNWE = 3.5      '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim sngPol(MTRDCOLS * 2, 1) As Single

    Dim lngCol As Long

    '

    lngCol = RGB(34, 139, 34)              '←線色

    For Jp = 0 To MTRDROWS - 1

        intDyp = MTRDTOPP + MTRDHSPC * Jp

        For Ip = 0 To MTRDCOLS - 1

            sngPol(Ip * 2 + 0, 0) = CSng(MTRDLEFT + MTRDSWID * Ip)

            sngPol(Ip * 2 + 0, 1) = CSng(intDyp + MTRDSHEI)

            sngPol(Ip * 2 + 1, 0) = sngPol(Ip * 2 + 0, 0) _

                                  + CSng(MTRDSWID / 2)

            sngPol(Ip * 2 + 1, 1) = CSng(intDyp + 0)

        Next Ip

        sngPol(MTRDCOLS * 2 + 0, 0) = CSng(MTRDLEFT _

                                    + MTRDSWID * MTRDCOLS)

        sngPol(MTRDCOLS * 2 + 0, 1) = CSng(intDyp + MTRDSHEI)

        '*ポリライン描画

        With ActiveDocument.Shapes.AddPolyline(sngPol)

            .Line.ForeColor = lngCol               '←線色

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

            .Line.DashStyle = msoLineSolid    '←線種

        End With

    Next Jp

End Sub