Option Explicit
Option Base 0
Public Sub 円と四角形模様描画マクロ()
Const GEOMLEFT = 90 '描画開始位置Ｘ
Const GEOMTOPP = 80 ' Ｙ
'
Const GEOMSWID = 30 '描画幅
Const GEOMSHEI = GEOMSWID '描画高さ
'
Const GEOMDMT1 = GEOMSWID * 0.8 '円(大)直径
Const GEOMDMT2 = GEOMSWID * 0.5 '円(小)直径
'
Const GEOMVSPC = 0 '横-間隔
Const GEOMHSPC = 0 '縦-間隔
Const GEOMCOLS = 6 '横/描画数
Const GEOMROWS = 5 '縦/描画数
'
Const GEOMLNWE = 1 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim lngCol As Long
'
lngCol = RGB(34, 139, 34) '←線色
For Jp = 0 To GEOMROWS - 1
intDyp = GEOMTOPP + (GEOMSHEI + GEOMHSPC) * Jp
For Ip = 0 To GEOMCOLS - 1
intDxp = GEOMLEFT + (GEOMSWID + GEOMVSPC) * Ip
'*四角形を描画
With ActiveDocument.Shapes.AddShape( _
msoShapeRectangle, intDxp, intDyp, _
GEOMSWID, GEOMSHEI)
.Fill.Visible = msoFalse
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol
.Line.Weight = GEOMLNWE
End With
'*対角線を描画
For Kp = 0 To 1
With ActiveDocument.Shapes.AddLine( _
intDxp, _
intDyp + IIf(Kp = 0, 0, GEOMSHEI), _
intDxp + GEOMSWID, _
intDyp + IIf(Kp = 1, 0, GEOMSHEI) _
).Line
.ForeColor.RGB = lngCol
.Weight = GEOMLNWE
End With
Next Kp
'*円(大)を描画
With ActiveDocument.Shapes.AddShape( _
msoShapeOval, _
intDxp + (GEOMSWID - GEOMDMT1) / 2, _
intDyp + (GEOMSWID - GEOMDMT1) / 2, _
GEOMDMT1, GEOMDMT1)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = vbWhite
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol
.Line.Weight = GEOMLNWE
End With
'*十字を描画
For Kp = 0 To 1
With ActiveDocument.Shapes.AddLine( _
intDxp + IIf(Kp = 0, 0, GEOMSWID / 2), _
intDyp + IIf(Kp = 1, 0, GEOMSHEI / 2), _
intDxp + IIf(Kp = 0, GEOMSWID, GEOMSWID / 2), _
intDyp + IIf(Kp = 1, GEOMSHEI, GEOMSHEI / 2) _
).Line
.ForeColor.RGB = lngCol
.Weight = GEOMLNWE
End With
Next Kp
'*円(小)を描画
With ActiveDocument.Shapes.AddShape( _
msoShapeOval, _
intDxp + (GEOMSWID - GEOMDMT2) / 2, _
intDyp + (GEOMSWID - GEOMDMT2) / 2, _
GEOMDMT2, GEOMDMT2)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = vbWhite
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol
.Line.Weight = GEOMLNWE
End With
Next Ip
Next Jp
End Sub
