【Word VBA】十字繋ぎ模様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 十字繋ぎ模様描画マクロ()

    Const CROSLEFT = 160             '描画開始位置Ｘ

    Const CROSTOPP = 80              '　　　　　　Ｙ

    '

    Const CROSSIZE = 36               '十字のサイズ

    '

    Const CROSCOLS = 5               '横描画数(奇数)

    Const CROSROWS = 6              '縦描画数

   '

    Const CROSLNLN = 2               '線の太さ

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

    Dim Ip As Integer, Jp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim intSxp As Integer, intSyp As Integer

    Dim intSzT As Integer, lngCol(1) As Long

    '

    '

    lngCol(0) = RGB(255, 228, 225)         '←塗りつぶし色

    lngCol(1) = vbRed                             '←線色

   '

    intSzT = CROSSIZE \ 3

    intSyp = CROSTOPP

    For Jp = 0 To CROSROWS - 1

        intSxp = CROSLEFT - intSzT * Jp

        For Ip = 0 To CROSCOLS - 1

            intDxp = intSxp

            intDyp = intSyp + IIf((Ip Mod 2) = 0, 0, intSzT)

            '*十字描画

            With ActiveDocument.Shapes.AddShape(msoShapeCross, _

                 intDxp, intDyp, CROSSIZE, CROSSIZE)

                .Fill.Visible = msoTrue

                .Fill.ForeColor.RGB = lngCol(0)　　'←塗りつぶし色

                .Line.Visible = msoTrue

                .Line.ForeColor.RGB = lngCol(1)　　'←線色

                .Line.Weight = CROSLNLN

                .Adjustments(1) = 1 / 3                 '切り欠け率

            End With

           intSxp = intSxp + IIf((Ip Mod 2) = 0, 2, 3) * intSzT

        Next Ip

        intSyp = intSyp + IIf((Ip Mod 2) = 0, 1, 2) * intSzT

    Next Jp

End Sub