【Word VBA】ハーリキンチェック描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub ハーリキンチェック描画マクロ()

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

    Const HLQNTOPP = 90 　　　　　　　 '　　　　　　Ｙ

    '

    Const HLQNWIDT = 25                      'ひし形幅

    Const HLQNHEIG = 25                       'ひし形高

    '

    Const HLQNCOLS = 8                        '横描画数

    Const HLQNROWS = 6                       '縦描画数

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

    Dim Ip As Integer, Jp As Integer

    Dim intDxp As Integer, intDyp As Integer

    Dim lngCol As Long

    '

    lngCol = vbBlack                            '←塗りつぶし色

    For Jp = 0 To HLQNROWS - 1

        intDyp = HLQNTOPP + HLQNHEIG * Jp

        For Ip = 0 To HLQNCOLS - 1

            intDxp = HLQNLEFT + HLQNWIDT * Ip

            '*ひし形描画

            With ActiveDocument.Shapes.AddShape(msoShapeDiamond, _

                intDxp, intDyp, HLQNWIDT, HLQNHEIG)

                .Fill.Visible = msoTrue

                .Fill.ForeColor.RGB = lngCol

                .Line.Visible = msoFalse

           End With

        Next Ip

    Next Jp

End Sub