【Word VBA】フック型模様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub フック型模様描画マクロ()

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

    Const HOOKTOPP = 100 　　　　　　'　　　　　　Ｙ

    '

    Const HOOKPMAG = 5　　                'ポリライン倍率

    '

    Const HOOKSWID = HOOKPMAG 　　'描画幅

    Const HOOKSHEI = HOOKPMAG * 6  '描画高さ

    '

    Const HOOKVSPC = HOOKPMAG * 1.5    '横-間隔

    Const HOOKHSPC = 0                            '縦-間隔

    Const HOOKCOLS = 15                          '横/描画数

    Const HOOKROWS = 5                          '縦/描画数

    '

    Const HOOKLNWE = 3                          '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim Kp As Integer, lngCol As Long

    Dim intDxp As Integer, intDyp As Integer

    Dim varPos As Variant

    Dim sngBas() As Single, sngDat() As Single

    '

    lngCol = RGB(0, 128, 128)                    '←線色

    '*ポリラインデータ設定

    varPos = Array(1, 3, 1, 3, 1, 3, 0, 2, 0, -2, -1, -3)

    ReDim sngBas((UBound(varPos, 1) - 1) \ 2, 1)

    ReDim sngDat((UBound(varPos, 1) - 1) \ 2, 1)

    '

    For Ip = LBound(varPos, 1) To UBound(varPos, 1) Step 2

        sngBas(Ip \ 2, 0) = CSng(varPos(Ip + 0) * HOOKPMAG)

        sngBas(Ip \ 2, 1) = CSng(varPos(Ip + 1) * HOOKPMAG)

    Next Ip

    For Jp = 0 To HOOKROWS - 1

        For Ip = 0 To HOOKCOLS - 1

            intDxp = HOOKLEFT + (HOOKSWID + HOOKVSPC) * Ip

            intDyp = HOOKTOPP + (HOOKSHEI + HOOKHSPC) * Jp _

                   + ((HOOKSHEI + HOOKHSPC) \ 2) * (Ip Mod 2)

            '*ポリライン描画位置設定

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

                sngDat(Kp, 0) = sngBas(Kp, 0) + intDxp

                sngDat(Kp, 1) = sngBas(Kp, 1) + intDyp

            Next Kp

            '*ポリライン描画

            With ActiveDocument.Shapes.AddPolyline(sngDat)

                .Fill.Visible = msoFalse

                .Line.Visible = msoTrue

                .Line.ForeColor = lngCol                 '←線色

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

            End With

        Next Ip

    Next Jp

End Sub