Option Explicit
Option Base 0
Public Sub 釘抜繋ぎ文様描画マクロ()
Const NAPULEFT = 80 '描画開始位置Ｘ
Const NAPUTOPP = 100 ' Ｙ
Const NAPUDISZ = 25 'ひし形の大きさ
Const NAPUHOSZ = 8 '穴の大きさ
Const NAPULNSZ = 3 '線の太さ
Const NAPUCLGP = 1 '列の間隔
'
Const NAPUROWS = 8 '縦の数
Const NAPUCOLS = 7 '横の数
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim intXp As Integer, intYp As Integer
Dim lngCl As Long
lngCl = RGB(0, 0, 128) '←塗りつぶし色
For Ip = 0 To NAPUCOLS - 1
intXp = NAPULEFT + _
(NAPUDISZ + NAPULNSZ * 2 + NAPUCLGP) * Ip
For Jp = 0 To NAPUROWS - 1
intYp = NAPUTOPP + (NAPUDISZ + 0) * Jp
'*ひし形を描画します
With ActiveDocument.Shapes.AddShape(msoShapeDiamond, _
intXp + NAPULNSZ, intYp, NAPUDISZ, NAPUDISZ)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCl
.Line.Visible = False
End With
'*ひし形の穴を描画します
With ActiveDocument.Shapes.AddShape(msoShapeDiamond, _
intXp + NAPULNSZ + (NAPUDISZ - NAPUHOSZ) / 2, _
intYp + (NAPUDISZ - NAPUHOSZ) / 2, _
NAPUHOSZ, NAPUHOSZ)
.Fill.Visible = True
.Fill.ForeColor.RGB = vbWhite
.Line.Visible = False
End With
Next Jp
'*左側の線を描画します
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intXp, NAPUTOPP, NAPULNSZ, (NAPUDISZ + 0) * NAPUROWS)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCl
.Line.Visible = False
End With
'*右側の線を描画します
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intXp + NAPULNSZ + NAPUDISZ, NAPUTOPP, NAPULNSZ, _
(NAPUDISZ + 0) * NAPUROWS)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCl
.Line.Visible = False
End With
Next Ip
End Sub
