【Word VBA】二筋格子模様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 二筋格子模様描画マクロ()

    Const BIFULEFT = 90　　　        '描画開始位置Ｘ

    Const BIFUTOPP = 90 　　　　　'　　　　　　Ｙ

    '

    Const BIFUVSPC = 25　　　        '縦線間隔

    Const BIFUHSPC = 25　　　        '横線間隔

    '

    Const BIFUCOLS = 8 　　　　　　'横格子数

    Const BIFUROWS = 7　　　　      '縦格子数

    '

    Const BIFULNWT = 3 　　　　　　'線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim intEpt(1) As Integer

    Dim intMpt(1) As Integer

    Dim lngCol As Long

    '

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

    '*横線#############################

    intEpt(0) = BIFULEFT

    intEpt(1) = BIFULEFT + BIFUVSPC * BIFUCOLS

    For Ip = 0 To BIFUROWS - 1

        intMpt(0) = BIFUTOPP + BIFUHSPC * Ip _

                  + BIFUHSPC / 3

        For Jp = 0 To 1

            intMpt(1) = intMpt(0) + BIFULNWT * 2 * Jp

            '*横線描画

            With ActiveDocument.Shapes.AddConnector( _

                 msoConnectorStraight, intEpt(0), _

                 intMpt(1), intEpt(1), intMpt(1)).Line

                .Weight = BIFULNWT

                .Style = msoLineSolid

                .ForeColor = lngCol

            End With

        Next Jp

    Next Ip

    '*縦線#############################

    intEpt(0) = BIFUTOPP

    intEpt(1) = BIFUTOPP + BIFUHSPC * BIFUROWS

    For Ip = 0 To BIFUCOLS - 1

        intMpt(0) = BIFULEFT + BIFUVSPC * Ip _

                  + BIFUVSPC / 3

        For Jp = 0 To 1

            intMpt(1) = intMpt(0) + BIFULNWT * 2 * Jp

            '*縦線描画

            With ActiveDocument.Shapes.AddConnector( _

                 msoConnectorStraight, intMpt(1), _

                 intEpt(0), intMpt(1), intEpt(1)).Line

                .Weight = BIFULNWT

                .Style = msoLineSolid

                .ForeColor = lngCol

            End With

        Next Jp

    Next Ip

End Sub