Option Explicit
Option Base 0
'
Public Sub 花青海波文様描画マクロ()
Const FWAVLEFT = 110 '描画開始位置Ｘ
Const FWAVTOPP = 125 ' Ｙ
'
Const FWAVFRAD = 4 '扇半径間隔
Const FWAVMARG = 10 '扇半径Ｘ数
Const FWAVSWID = (FWAVFRAD * FWAVMARG) '描画幅
Const FWAVSHEI = (FWAVSWID - 5) '描画高さ
'
Const FWAVPRAD = (FWAVSWID / 2) '花びら位置径
Const FWAVPWID = 5 '花びら幅
Const FWAVPHEI = FWAVPRAD '花びら丈
Const FWAVPANG = 20 '花びら刻み角
'
Const FWAVCOLS = 5 '横/描画数
Const FWAVROWS = 4 '縦/描画数
'
Const FWAVLNWE = 3 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer, lngCol As Long
Dim intCxp As Integer, intCyp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim intRad As Integer, sngSit As Single
Dim sngRnd As Single, sngAng As Single
'
lngCol = RGB(123, 104, 238) '←描画色
'
sngRnd = (4 * Atn(1)) / 180
For Jp = 0 To FWAVROWS - 1
For Ip = 0 To FWAVCOLS - 1
intCyp = FWAVTOPP + (FWAVSHEI) * Jp _
+ (FWAVSHEI \ 2) * (Ip Mod 2)
intCxp = FWAVLEFT + (FWAVSWID + 10) * Ip
'
For Kp = 0 To 1
intRad = FWAVFRAD * (Kp + (FWAVMARG - 1)) '←半径
'*描画円弧角度計算
sngAng = (90 / FWAVMARG) _
* (Kp + (FWAVMARG - 1)) * sngRnd
sngSit = Atn(FWAVSWID * Sin(sngAng) _
/ (FWAVSWID - FWAVSWID * Cos(sngAng))) / sngRnd
'*円弧描画
With ActiveDocument.Shapes.AddShape( _
msoShapeArc, _
intCxp - intRad, intCyp - intRad, _
intRad * 2, intRad * 2)
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = lngCol '←線色
.Line.Weight = FWAVLNWE '←線の太さ
'↓描画角
.Adjustments(1) = -170 + sngSit
.Adjustments(2) = 0 - sngSit
End With
Next Kp
For Kp = 0 To 4
intDxp = FWAVPRAD * Cos(sngRnd _
* (-45 - FWAVPANG * Kp)) + intCxp
intDyp = FWAVPRAD * Sin(sngRnd _
* (-45 - FWAVPANG * Kp)) + intCyp
'*花びら(楕円)描画
With ActiveDocument.Shapes.AddShape(msoShapeOval, _
intDxp - FWAVPWID / 2, intDyp - FWAVPHEI / 2, _
FWAVPWID, FWAVPHEI)
.Fill.ForeColor.RGB = lngCol '←塗りつぶし色
.Fill.Visible = True '←塗りつぶし有無
.Line.Visible = False '←線の有無
.Rotation = -1 * FWAVPANG * Kp - 135
End With
Next Kp
Next Ip
Next Jp
End Sub
