【Word VBA】穴あき四角形模様描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 穴あき四角形模様描画マクロ()

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

    Const FRAMTOPP = 90                   '　　　　　　Ｙ

    '

    Const FRAMSWID = 32                   '描画幅

    Const FRAMSHEI = 24                    '描画高さ

    '

    Const FRAMVSPC = 10                    '横-間隔

    Const FRAMHSPC = 10                    '縦-間隔

    Const FRAMCOLS = 6                      '横/描画数

    Const FRAMROWS = 5                     '縦/描画数

    '

    Const FRAMHOPS = 0.25                  '穴比率から

    Const FRAMHOPE = 0.45                  '穴比率まで

    '

    Const FRAMANGL = -25                   '傾き

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

    Dim Ip As Integer, Jp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim lngCol As Long, sngHsp As Single

　 '　

    lngCol = RGB(65, 105, 225) 　　　　　　　'←塗りつぶし色

    sngHsp = (FRAMHOPE - FRAMHOPS) / (FRAMCOLS - 1)

    For Jp = 0 To FRAMROWS - 1

        intDyp = FRAMTOPP + (FRAMSHEI + FRAMHSPC) * Jp

        For Ip = 0 To FRAMCOLS - 1

            intDxp = FRAMLEFT + (FRAMSWID + FRAMVSPC) * Ip

            '*穴あき四角形描画

             With ActiveDocument.Shapes.AddShape( _

                  msoShapeFrame, _

                 intDxp, intDyp, FRAMSWID, FRAMSHEI)

                .Fill.Visible = msoTrue

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

                .Line.Visible = msoFalse

                '↓四角形に対する穴比率(奇数行：増/偶数行：減)

                .Adjustments(1) = IIf((Jp Mod 2) = 0, _

                     FRAMHOPS + sngHsp * Ip, _

                     FRAMHOPE - sngHsp * Ip)

                .Rotation = FRAMANGL

             End With

        Next Ip

    Next Jp

End Sub

《蛇足》

　模様としては、穴の大きさは一定が綺麗でしょうが、マクロで描画するということで、あえて増減させてみました。