Option Explicit
Option Base 0
Public Sub 紗綾形文様描画マクロ()
Const SAYALEFT = 100 '描画開始位置 Ｘ
Const SAYATOPP = 80 ' Ｙ
Const SAYAPOLY = 0.1 'ポリライン描画倍率
'
Const SAYACOLS = 5 '描画数-横
Const SAYAROWS = 4 '描画数-縦
'
Const SAYALNWE = 2 '描画線の太さ
'
Const POLTOPID = 22 'ポリラインデータID
Const POLLEFID = 7 '(連結描画用)
Const POLLUPID = 25
Const POLRUPID = 18
Const POLLDPID = 4
Const POLRDPID = 11
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer, Kp As Integer
Dim varPoly As Variant
Dim sngPBas() As Single, sngPDat() As Single
Dim sngXps As Single, sngYps As Single
Dim sngXpw(SAYAROWS) As Single, sngYpw(SAYAROWS) As Single
Dim lngCol As Long
'
'*ポリラインベースデータ
varPoly = Array(-6, -37, -132, 88, -176, 43, -145, 12, -189, -32, _
-220, -1, -264, -45, -296, -13, 13, 296, 45, 264, 1, 220, 32, 189, _
-12, 145, -43, 176, -88, 132, 132, -88, 176, -43, 145, -12, 189, _
32,220, 1, 264, 45, 296, 13, -13, -296, -45, -264, -1, -220, -32, _
-189,12, -145, 43, -176, 88, -132, -6, -37)
'ポリラインベースデータ設定
ReDim sngPBas((UBound(varPoly, 1) - 1) \ 2, 1)
ReDim sngPDat((UBound(varPoly, 1) - 1) \ 2, 1)
For Kp = LBound(varPoly, 1) To UBound(varPoly, 1) Step 2
sngPBas(Kp \ 2, 0) = CSng(varPoly(Kp + 0) * SAYAPOLY)
sngPBas(Kp \ 2, 1) = CSng(varPoly(Kp + 1) * SAYAPOLY)
Next Kp
'
lngCol = RGB(30, 144, 255) '←描画色
'*描画開始位置
sngXps = SAYALEFT - sngPBas(POLLEFID, 0) _
+ sngPBas(POLLUPID, 0)
sngYps = SAYATOPP - sngPBas(POLTOPID, 1) _
+ sngPBas(POLLUPID, 1)
'*左一列描画
For Ip = 0 To SAYAROWS - 1
For Kp = LBound(sngPBas, 1) To UBound(sngPBas, 1)
sngPDat(Kp, 0) = sngPBas(Kp, 0) _
+ (sngXps - sngPBas(POLLUPID, 0))
sngPDat(Kp, 1) = sngPBas(Kp, 1) _
+ (sngYps - sngPBas(POLLUPID, 1))
Next Kp
GoSub DRAW_POLYLINE
sngXps = sngPDat(POLRDPID, 0)
sngYps = sngPDat(POLRDPID, 1)
'*左端描画位置記憶
sngXpw(Ip) = sngPDat(POLRUPID, 0)
sngYpw(Ip) = sngPDat(POLRUPID, 1)
Next Ip
'*左一列を起点に全体描画
For Jp = 0 To SAYAROWS - 1
sngXps = sngXpw(Jp): sngYps = sngYpw(Jp)
For Ip = 0 To SAYACOLS - 2
For Kp = LBound(sngPBas, 1) To UBound(sngPBas, 1)
sngPDat(Kp, 0) = sngPBas(Kp, 0) _
+ (sngXps - sngPBas(POLLDPID, 0))
sngPDat(Kp, 1) = sngPBas(Kp, 1) _
+ (sngYps - sngPBas(POLLDPID, 1))
Next Kp
GoSub DRAW_POLYLINE
sngXps = sngPDat(POLRUPID, 0)
sngYps = sngPDat(POLRUPID, 1)
Next Ip
Next Jp
Exit Sub
'==========================================
DRAW_POLYLINE: '*ポリライン描画処理
With ActiveDocument.Shapes.AddPolyline(sngPDat)
.Fill.Visible = msoFalse
.Line.Visible = msoTrue
.Line.ForeColor = lngCol '←線色
.Line.Weight = SAYALNWE '←線の太さ
End With
Return
End Sub
蛇足
ポリラインデータを作成・編集するため、VB.NET2019 でプログラムを作って、そのデータを使用しています。
