【Word VBA】いちご描画マクロ▽ソースコード
記事IT・テクノロジー
Option Explicit
Option Base 0
'
Public Sub いちご描画マクロ()
Const STRBLEFT = 90 '描画開始位置Ｘ
Const STRBTOPP = 80 ' Ｙ
'
Const STRBCOLS = 5 '横/描画数
Const STRBROWS = 4 '縦/描画数
'
Const STRBBBZM = 0.75 'ベジェ曲線描画倍率(本体)
Const STRBHBZM = 0.75 'ベジェ曲線描画倍率(ヘタ)
'
Const STRBBOSX = 27.75 * STRBBBZM '描画調整位置
Const STRBBOSY = 28.05 * STRBBBZM
Const STRBHOSX = STRBBOSX '描画調整位置
Const STRBHOSY = 0 * STRBHBZM
'
Const STRBVPIT = 56 * STRBBBZM '横-間隔
Const STRBHPIT = 65 * STRBBBZM '縦-間隔
'
Const STRBDEFX = 20 * STRBBBZM '変形幅
Const STRBWANG = 30 '振れ幅
Const STRBLNWE = 1 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim sngBBsB() As Single, sngBDtB() As Single
Dim sngBBsH() As Single, sngBDtH() As Single
Dim varBezB As Variant, varBezH As Variant
Dim lngCol(3) As Long, varNam(1) As Variant
'*ベジェ曲線描画データ－(イチゴの本体)
varBezB = Array(
-11.7, -25.35, -18.15, -23.1, -27.75, -13.65, -20.55, 6.15, _
-18.3, 13.95, -11.1, 23.55, 0#, 27.45, 12.6, 24.15, _
18.3, 14.85, 22.35, 7.95, 25.95, -1.8, 28.65, -15.75, _
13.8, -25.95, 9.6, -28.05, -5.25, -27.6, -11.7, -25.35)
'*ベジェ曲線描画データ－(イチゴのヘタ)
varBezH = Array(-1.5, -6.9, -1.65, -6.75, -1.5, -3.6, -1.8, -3.3, _
-2.1, -3.15, -2.55, -3.9, -3.15, -3.75, -3.6, -3.6, _
-7.5, -1.65, -8.4, -1.5, -9.45, -1.2, -10.5, -1.2, _
-11.55, -1.2, -14.7, -2.4, -13.5, -0.75, -12.3, -0.3, _
-11.4, 0.15, -8.1, 0.3, -7.8, 0.9, -7.35, 1.35, _
-8.7, 2.1, -9.75, 2.55, -10.5, 2.85, -13.5, 3.15, _
-13.35, 3.45, -13.2, 3.9, -10.5, 4.5, -9.15, 4.5, _
-4.5, 4.35, -4.5, 2.7, -3.9, 3.15, -3.15, 3.6, _
-1.95, 7.05, -1.35, 7.2, -0.75, 7.35, -0.3, 2.25, _
0#, 2.25, 0.3, 2.25, 2.55, 6.9, 3#, 6.6, _
3.3, 6.3, 3.3, 2.1, 3.9, 1.5, 4.35, 1.2, _
5.1, 3.6, 6#, 4.2, 6.9, 4.65, 9.6, 5.25, _
9.9, 4.65, 10.05, 4.05, 6.9, 1.65, 7.5, 0.9, _
7.95, 0.15, 12.3, 0.3, 13.2, 0#, 13.95, -1.5, _
10.05, -1.2, 8.55, -1.65, 7.05, -2.1, 4.95, -3.75, _
3.6, -3.9, 2.25, -4.35, 1.2, -3.45, 0.75, -3.6, _
0.3, -3.75, 0.75, -6.45, 0.45, -6.9, -0.75, -7.05, _
-1.35, -7.35, -1.5, -6.9)
'ベジエ曲線データ設定
ReDim sngBBsB(UBound(varBezB, 1) \ 2, 1)
ReDim sngBDtB(UBound(varBezB, 1) \ 2, 1)
For Kp = LBound(sngBBsB, 1) To UBound(sngBBsB, 1)
sngBBsB(Kp, 0) = CSng(varBezB(Kp * 2 + 0)) * STRBBBZM
sngBBsB(Kp, 1) = CSng(varBezB(Kp * 2 + 1)) * STRBBBZM
Next Kp
'
ReDim sngBBsH(UBound(varBezH, 1) \ 2, 1)
ReDim sngBDtH(UBound(varBezH, 1) \ 2, 1)
For Kp = LBound(sngBBsH, 1) To UBound(sngBBsH, 1)
sngBBsH(Kp, 0) = CSng(varBezH(Kp * 2 + 0)) * STRBHBZM
sngBBsH(Kp, 1) = CSng(varBezH(Kp * 2 + 1)) * STRBHBZM
Next Kp
'
Randomize '*乱数系列初期化
'
lngCol(0) = vbBlack '←線色
lngCol(1) = RGB(255, 0, 0) '←塗りつぶし色(本体）
lngCol(2) = vbWhite '←塗りつぶし色(つぶ)
lngCol(3) = RGB(0, 128, 0) '←塗りつぶし色(へた)
For Jp = 0 To STRBROWS - 1
intDyp = STRBTOPP + STRBHPIT * Jp
For Ip = 0 To STRBCOLS - 1
intDxp = STRBLEFT + STRBVPIT * Ip
''*イチゴ本体描画 位置設定
For Kp = LBound(sngBBsB, 1) To UBound(sngBBsB, 1)
sngBDtB(Kp, 0) = sngBBsB(Kp, 0) _
+ intDxp + STRBBOSX
sngBDtB(Kp, 1) = sngBBsB(Kp, 1) _
+ intDyp + STRBBOSY
If Kp = 5 Or Kp = 7 Then '↓乱数でちょっと変形
sngBDtB(Kp, 0) = sngBDtB(Kp, 0) _
+ CInt(Rnd * STRBDEFX) - (STRBDEFX / 2)
End If
Next Kp
'*イチゴ本体描画
With ActiveDocument.Shapes.AddCurve(sngBDtB)
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol(0)
.Line.Weight = STRBLNWE
.Fill.Visible = msoTrue
.Fill.Patterned msoPattern5Percent
.Fill.BackColor.RGB = lngCol(1) '←地
.Fill.ForeColor.RGB = lngCol(2) '←つぶ
varNam(0) = .Name
End With
'*イチゴヘタ描画 位置設定
For Kp = LBound(sngBBsH, 1) To UBound(sngBBsH, 1)
sngBDtH(Kp, 0) = sngBBsH(Kp, 0) _
+ intDxp + STRBHOSX
sngBDtH(Kp, 1) = sngBBsH(Kp, 1) _
+ intDyp + STRBHOSY
Next Kp
'*イチゴヘタ描画
With ActiveDocument.Shapes.AddCurve(sngBDtH)
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol(0)
.Line.Weight = STRBLNWE
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = lngCol(3)
varNam(1) = .Name
End With
'*描画部分をグループ化して、ランダムに傾ける
ActiveDocument.Shapes.Range(varNam).Group.Rotation = _
CInt(Rnd * STRBWANG) - (STRBWANG / 2)
Next Ip
Next Jp
'*グループ化による選択解除
Selection.Collapse Direction:=wdCollapseEnd
End Sub
