Option Explicit
Option Base 0
Public Sub 網代麻の葉文様描画マクロ()
Const HEWILEFT = 80 '描画開始位置Ｘ
Const HEWITOPP = 100 ' Ｙ
Const HEWILENG = 30 '平行四辺形底辺長さ
Const HEWICOLS = 8 '列数
Const HEWIROWS = 5 '行数
'
Const HEWILNWE = 1 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim intWid As Integer, intHei As Integer
Dim intDxp As Integer, intDyp As Integer
Dim lngCol(1) As Long
'
lngCol(0) = vbWhite '←塗りつぶし色
lngCol(1) = RGB(128, 0, 128) '←線色(紫)
'
intWid = HEWILENG
intHei = HEWILENG \ 2
For Jp = 0 To HEWIROWS - 1
intDyp = HEWITOPP + (HEWILENG + 4) * Jp
intDxp = HEWILEFT - (Jp * 2)
For Ip = 0 To HEWICOLS - 1
'《変数のあとの＋０/－０は、微調整の痕跡》
'*底辺の平行四辺形描画
With ActiveDocument.Shapes.AddShape(msoShapeParallelogram, _
intDxp + 0, intDyp + 0, intWid - 0, intHei)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCol(0)
.Line.Visible = True
.Line.ForeColor.RGB = lngCol(1)
.Line.Weight = HEWILNWE
.Rotation = 0
.Adjustments(1) = 1 / Sqr(3)
End With
'*右斜めの平行四辺形描画
With ActiveDocument.Shapes.AddShape(msoShapeParallelogram, _
intDxp + 1, intDyp - CInt(intWid / Sqr(3)) + 0, _
intWid + 0, intHei - 0)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCol(0)
.Line.Visible = True
.Line.ForeColor.RGB = lngCol(1)
.Line.Weight = HEWILNWE
.Rotation = 60
.Adjustments(1) = 1 / Sqr(3)
End With
'*左斜めの平行四辺形描画
With ActiveDocument.Shapes.AddShape(msoShapeParallelogram, _
intDxp - intHei + 1, _
intDyp - CInt(intHei / Sqr(3)) - 0, _
intWid, intHei)
.Fill.Visible = True
.Fill.ForeColor.RGB = lngCol(0)
.Line.Visible = True
.Line.ForeColor.RGB = lngCol(1)
.Line.Weight = HEWILNWE
.Rotation = -60
.Adjustments(1) = 1 / Sqr(3)
End With
intDxp = intDxp + intWid - IIf((Ip Mod 2) = 0, 0, 3)
intDyp = intDyp + (intHei + 0) * IIf((Ip Mod 2) = 0, -1, 1)
Next Ip
Next Jp
End Sub
