【Word VBA】三崩し文様描画マクロ▽ソースコード

Option Explicit

Option Base 0

Public Sub 三崩し文様描画マクロ()

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

    Const THRCTOPP = 80                          ' Ｙ

    Const THRCLENG = 24                          '一辺の長さ

    Const THRCMARG = 3                           'マージン

    Const THRCSZPR = 0.6                         '線と余白比

    Const THRCCOLS = 7                           '横並び数

    Const THRCROWS = 5                          '縦並び数

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

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

    Dim intDxp As Integer, intDyp As Integer

    Dim blnDir As Boolean, lngCol As Long

    '

    lngCol = RGB(184, 134, 11) '←塗りつぶし色

    For Jp = 0 To THRCROWS - 1

        intDyp = THRCTOPP + (THRCLENG + THRCMARG) * Jp

        For Ip = 0 To THRCCOLS - 1

            intDxp = THRCLEFT + (THRCLENG + THRCMARG) * Ip

            blnDir = IIf(((Ip + Jp) Mod 2) = 0, True, False) 　   '←縦横

            For Kp = 0 To 2

                '*長方形描画

            With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _

                    IIf(blnDir = True, intDxp, _

                                             intDxp + (THRCLENG / 3) * Kp), _

                    IIf(blnDir = True, intDyp + _

                                                (THRCLENG / 3) * Kp, intDyp), _

                    IIf(blnDir = True, _

                             THRCLENG, (THRCLENG / 3) * THRCSZPR), _

                    IIf(blnDir = True, _

                               (THRCLENG / 3) * THRCSZPR, THRCLENG))

                    .Fill.Visible = msoTrue                    '←塗りつぶし

                    .Fill.ForeColor.RGB = lngCol

                    .Line.Visible = msoFalse　　　　　　'←線　　　

                End With

            Next Kp

        Next Ip

    Next Jp

End Sub