Option Explicit
Option Base 0
Public Sub 七宝文様描画マクロ()
Const SEVELFT = 100 '描画開始位置 X
Const SEVETOP = 80 ' Y
Const SEVELNG = 30 '間隔幅(半径)
Const SEVECOL = 8 '列数
Const SEVEROW = 6 '行数
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim intXp As Integer, intYp As Integer
Dim sngDat(3, 1) As Single, sngXdt As Single
Dim lngCl As Long
'
lngCl = RGB(148, 0, 211) '←描画色
sngXdt = (4# * (Sqr(2) - 1)) / 3# * SEVELNG '*ベジェ曲線用
For Jp = 0 To SEVEROW - 1
intYp = SEVETOP + SEVELNG * Jp
For Ip = 0 To SEVECOL - 1
intXp = SEVELFT + SEVELNG * Ip
'*1/4円の弦、上側 ベジェ曲線データ
sngDat(0, 0) = intXp
sngDat(0, 1) = intYp + SEVELNG
sngDat(1, 0) = intXp
sngDat(1, 1) = intYp + SEVELNG - sngXdt
sngDat(2, 0) = intXp + SEVELNG - sngXdt
sngDat(2, 1) = intYp
sngDat(3, 0) = intXp + SEVELNG
sngDat(3, 1) = intYp
GoSub ベジェ曲線描画_Sub
'*1/4円の弦、下側 ベジェ曲線データ
sngDat(0, 0) = intXp
sngDat(0, 1) = intYp + SEVELNG
sngDat(1, 0) = intXp + sngXdt
sngDat(1, 1) = intYp + SEVELNG
sngDat(2, 0) = intXp + SEVELNG
sngDat(2, 1) = intYp + sngXdt
sngDat(3, 0) = intXp + SEVELNG
sngDat(3, 1) = intYp
GoSub ベジェ曲線描画_Sub
Next Ip
Next Jp
Exit Sub
'==========================================
ベジェ曲線描画_Sub:
With ActiveDocument.Shapes.AddCurve(sngDat)
.Fill.Visible = True '←塗りつぶし
.Fill.ForeColor.RGB = lngCl
.Line.Visible = msoTrue '←線
.Line.ForeColor.RGB = lngCl
.Rotation = ((Jp Mod 2) + (Ip Mod 2)) * 90
End With
Return
End Sub
蛇足
「七宝」とは仏教で、七つの宝物を示す言葉だそうです。
金(こん)、銀(ごん)、瑠璃(るり)、玻瓈(はり)、
硨磲(しゃこ)、赤珠(しゃくしゅ)、碼碯(めのう)
ワードにはパワーポイントの図形の重なり抽出機能が無いので、ベジェ曲線を使用しました。