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

Option Explicit

Option Base 0

'

Public Sub 網目文様描画マクロ()

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

    Const MESHTOPP = 100　　　　　　     '　　　　　　Ｙ

    Const MESHWIDT = 24 　　　　　　　　'メッシュの幅

    Const MESHHEIG = 40 　　　　　　　　 'メッシュの高さ

    Const MESHCOLS = 7                           '列数

    Const MESHROWS = 3                         '行数

     '

    Const MESHLNWE = 1.5                      '線の太さ

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

    Dim Ip As Integer, Jp As Integer, Kp As Integer

    Dim Lp As Integer, lngCol As Long

    Dim intDxp As Integer, intDyp As Integer

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

    '

    '*ベジェ曲線基礎データ

    sngBas(0, 0) = 0: sngBas(0, 1) = 0

    sngBas(1, 0) = MESHWIDT / 4: sngBas(1, 1) = 0

    sngBas(2, 0) = MESHWIDT / 4: sngBas(2, 1) = MESHHEIG / 2

    sngBas(3, 0) = MESHWIDT / 2: sngBas(3, 1) = MESHHEIG / 2

    '

    lngCol = vbRed                          '←線色

    For Jp = 0 To MESHROWS - 1

        intDyp = MESHTOPP + MESHHEIG * Jp

        For Ip = 0 To MESHCOLS - 1

            intDxp = MESHLEFT + MESHWIDT * Ip

            For Kp = 0 To 3

                For Lp = 0 To 3

                    sngDat(Lp, 0) = intDxp _

                    + IIf((Kp \ 2) = 0, sngBas(Lp, 0), _

                            MESHWIDT - sngBas(Lp, 0))

                    sngDat(Lp, 1) = intDyp _

                    + MESHHEIG / 2 + sngBas(Lp, 1) _

                            * IIf(Kp Mod 2 = 0, -1, 1)

                Next Lp

                '*ベジェ曲線描画

                With ActiveDocument.Shapes.AddCurve(sngDat)

                    .Fill.Visible = False

                    .Line.Visible = msoTrue

                    .Line.ForeColor.RGB = lngCol

                    .Line.Weight = MESHLNWE

                End With

            Next Kp

        Next Ip

   Next Jp

End Sub