【Word VBA】一の字繋ぎ文様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 一の字繋ぎ文様描画マクロ()

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

    Const BRCKTOPP = 80 　　　　　　　  '　　　　　　Ｙ

    '

    Const BRCKWIDT = 40                       '矩形幅

    '矩形高さ　= 矩形幅の半分

    Const BRCKHEIG = (BRCKWIDT / 2)

    '

    Const BRCKCOLS = 6                         '横　描画数

    Const BRCKROWS = 8                        '縦　描画数

    '

    Const BRCKJNWD = 3                        '目地幅

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

    Dim Ip As Integer, Jp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim intWid As Integer

    Dim lngCol(1) As Long

    '

    lngCol(0) = RGB(178, 34, 34)                '←矩形の色

    lngCol(1) = RGB(220, 220, 220)            '←目地の色

    For Jp = 0 To BRCKROWS - 1

        intDyp = BRCKTOPP + BRCKHEIG * Jp

        For Ip = 0 To BRCKCOLS - 1

            intDxp = BRCKLEFT + BRCKWIDT * Ip _

                   + BRCKHEIG * (Jp Mod 2)

            '*両端処理

            If ((Jp Mod 2) = 0 And Ip = 0) Or _

               ((Jp Mod 2) = 1 And Ip = BRCKCOLS - 1) Then

               If ((Jp Mod 2) = 0 And Ip = 0) Then intDxp = _

                                                                     intDxp + BRCKHEIG

               intWid = BRCKHEIG

            Else

               intWid = BRCKWIDT

            End If

            '*長方形描画

            With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _

                intDxp, intDyp, intWid, BRCKHEIG)

                .Fill.Visible = msoTrue

                .Fill.ForeColor.RGB = lngCol(0)

                .Line.Visible = msoTrue

                .Line.ForeColor.RGB = lngCol(1)

                .Line.Weight = BRCKJNWD

           End With

      Next Ip

  Next Jp

End Sub