Option Explicit
Option Base 0
Public Sub 曲輪繋ぎ文様描画マクロ()
Const KURULEFT = 120 '描画開始位置Ｘ
Const KURUTOPP = 80 ' Ｙ
Const KURUCISZ = 24 '円の大きさ
Const KURICIOV = 0.25 '円の重なり
'
Const KURUVLSZ = 5 '縦線の太さ
Const KURUVLGP = 3 '縦線の間隔
'
Const KURUROWS = 6 '縦の数
Const KURUCOLS = 5 '横の数
'
Const KURILNWE = 1.5 '線(円)の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer
Dim intXpt As Integer, intYpt As Integer
Dim lngCol As Long
'
lngCol = RGB(165, 42, 42) '←線色(茶色)
For Ip = 0 To KURUCOLS - 1
intXpt = KURULEFT + (KURUCISZ + KURUVLSZ * 3 _
+ KURUVLGP * 2) * Ip
For Jp = 0 To KURUROWS - 1
intYpt = KURUTOPP + KURUCISZ \ 2 _
+ KURUCISZ * (2 - KURICIOV * 2) * Jp
'*円描画(２つ)
For Kp = 0 To 1
With ActiveDocument.Shapes.AddShape(msoShapeOval, _
intXpt - KURUCISZ \ 2, _
intYpt - KURUCISZ \ 2 _
+ (KURUCISZ * (1 - KURICIOV)) * Kp, _
KURUCISZ, KURUCISZ)
.Fill.Visible = False
.Line.Visible = True
.Line.ForeColor.RGB = lngCol '←線色
.Line.Weight = KURILNWE '←線の太さ
End With
Next Kp
'*中央線描画
With ActiveDocument.Shapes.AddLine(intXpt, _
intYpt - KURUCISZ \ 2, _
intXpt, _
intYpt + KURUCISZ * (1 + KURICIOV * 1)).Line
.ForeColor.RGB = lngCol '←線色
.Weight = KURILNWE '←線の太さ
End With
Next Jp
'*左側の線を描画
For Kp = 0 To 1
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intXpt - KURUCISZ \ 2 - KURUVLSZ _
- (KURUVLSZ + KURUVLGP) * Kp, _
KURUTOPP, KURUVLSZ, _
KURUCISZ * (2 - KURICIOV * 2) * KURUROWS _
+ KURUCISZ * KURICIOV)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCol
.Line.Visible = False
End With
Next Kp
'*右側の線を描画
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intXpt + KURUVLSZ + KURUCISZ \ 2 - KURUVLSZ, _
KURUTOPP, KURUVLSZ, _
KURUCISZ * (2 - KURICIOV * 2) * KURUROWS _
+ KURUCISZ * KURICIOV)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCol
.Line.Visible = False
End With
Next Ip
End Sub
