Option Explicit
Option Base 0
'
Public Sub 笹の葉模様描画マクロ()
Const BMBGLEFT = 90 '描画開始位置Ｘ
Const BMBGTOPP = 80 ' Ｙ
'
Const BMBGVSPC = 60 '横-間隔
Const BMBGHSPC = 35 '縦-間隔
'
Const BMBGCOLS = 5 '横/描画数
Const BMBGROWS = 5 '縦/描画数
'
Const BMBGBZMG = 1.2 'ベジェ倍率
Const BMBGLNSP = (9 * BMBGBZMG) '葉脈
Const BMBGLNEP = (18 * BMBGBZMG)
Const BMBGLNWT = 0.75 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer, Lp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim sngBBs(6, 1) As Single, sngBDt(6, 1) As Single
Dim varBez As Variant, sngRnd As Single
Dim sngSin As Single, sngCos As Single
Dim lngCol(1) As Long
'
'*笹の葉ベジェ曲線データ
varBez = Array(0, 4.8, -5#, 5.3, -4.5, 13.8, 0#, _
24.6, 4.5, 13.8, 5#, 5.3, 0, 4.8)
'*ベジェ曲線データ設定
For Lp = LBound(sngBBs, 1) To UBound(sngBBs, 1)
sngBBs(Lp, 0) = CSng(varBez(Lp * 2 + 0)) * BMBGBZMG
sngBBs(Lp, 1) = CSng(varBez(Lp * 2 + 1)) * BMBGBZMG * -1
Next Lp
'
sngRnd = (4 * Atn(1)) / 180
lngCol(0) = RGB(0, 100, 0) '←笹の葉の色
lngCol(1) = vbGreen '←葉脈の色
For Jp = 0 To BMBGROWS - 1
intDyp = BMBGTOPP + BMBGHSPC * Jp
For Ip = 0 To BMBGCOLS - IIf((Jp Mod 2) = 0, 1, 2)
intDxp = BMBGLEFT _
+ BMBGVSPC * Ip + (BMBGVSPC / 2) * (Jp Mod 2)
'*笹の葉を３枚描画
For Kp = 0 To 2
sngSin = Sin(sngRnd * (120 + 60 * Kp))
sngCos = Cos(sngRnd * (120 + 60 * Kp))
For Lp = LBound(sngBDt, 1) To UBound(sngBDt, 1)
sngBDt(Lp, 0) = sngBBs(Lp, 0) * sngCos _
- sngBBs(Lp, 1) * sngSin + intDxp
sngBDt(Lp, 1) = sngBBs(Lp, 0) * sngSin _
+ sngBBs(Lp, 1) * sngCos + intDyp
Next Lp
'*笹の葉描画
With ActiveDocument.Shapes.AddCurve(sngBDt)
.Line.Visible = msoFalse
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = lngCol(0)
End With
'*笹の葉脈描画
With ActiveDocument.Shapes.AddLine( _
intDxp + BMBGLNSP * sngSin, _
intDyp - BMBGLNSP * sngCos, _
intDxp + BMBGLNEP * sngSin, _
intDyp - BMBGLNEP * sngCos).Line
.ForeColor.RGB = lngCol(1)
.Weight = BMBGLNWT
End With
Next Kp
Next Ip
Next Jp
End Sub
