【Word VBA】千鳥模様描画マクロ▽ソースコード
記事IT・テクノロジー
Option Explicit
Option Base 0
'
Public Sub 千鳥模様描画マクロ()
Const CHIDLEFT = 80 '描画開始位置Ｘ
Const CHIDTOPP = 90 ' Ｙ
'
Const CHIDVSPC = 80 '横-間隔
Const CHIDHSPC = 70 '縦-間隔
'
Const CHIDCOLS = 4 '横/描画数
Const CHIDROWS = 4 '縦/描画数
'
Const CHIDBZM1 = 0.4 'ベジェ曲線描画倍率
Const CHIDBZM2 = CHIDBZM1
'
Const CHIDLFDX = 80 * CHIDBZM1 '千鳥足１相対位置
Const CHIDLFDY = 10 * CHIDBZM1
Const CHIDRFDX = 56 * CHIDBZM1 '千鳥足２相対位置
Const CHIDRFDY = 50 * CHIDBZM1
'
Const CHIDEYSZ = 20 * CHIDBZM1 '千鳥目玉大きさ
Const CHIDEYDX = -30 * CHIDBZM1 '千鳥目玉相対位置
Const CHIDEYDY = -36 * CHIDBZM1
'
Const CHIDBSWD = 20 * CHIDBZM1 '千鳥の胸の大きさ
Const CHIDBSHT = 50 * CHIDBZM1
Const CHIDBSDX = 25 * CHIDBZM1 '千鳥の胸相対位置
Const CHIDBSDY = -15 * CHIDBZM1
'
Const CHIDLNWE = 1 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer, Lp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim intExp As Integer, intEyp As Integer
Dim lngCol(2) As Long
Dim varBz1 As Variant, varBz2 As Variant
Dim sngBB1() As Single, sngBB2() As Single
Dim sngBD1() As Single, sngBD2() As Single
Dim sngLT1(1) As Single
'
'** 千鳥の身体のベジェ曲線データ
varBz1 = Array( _
76.21, 28.51, 76.18, 30.27, 73.07, 35.23, 71.5, 37.93, 69.93, 40.63, 69.27, 41.86, 66.79, 44.72, 64.31, 47.57, 60.13, 52.48, 56.62, 55.08, 53.1, 57.69, 49.11, 59.13, 45.69, 60.36, 42.27, 61.58, 39.25, 62.09, 36.08, 62.43, 32.91, 62.78, 30.18, 62.59, 26.66, 62.43, 23.14, 62.28, 18.27, 61.99, 14.98, 61.49, 11.68, 60.99, 9.13, 59.48, 6.87, 59.42, 4.61, 59.35, 3.86, 59.98, 1.41, 61.11, -1.04, 62.24, -7.82, 66.2, -7.82, 66.2, -10.84, 67.77, -13.13, 69.19, -16.68, 70.54, -20.23, 71.89, -24.66, 73.58, -29.11, 74.31, -33.57, 75.03, -39.04, 75.44, -43.44, 74.87, -47.83, 74.31, -51.76, 72.67, -55.49, 70.91, -59.23, 69.16, -62.78, 66.61, -65.86, 64.32, -68.93, 62.02, -72.48, 58.69, -73.96, 57.16, -75.44, 55.62, -76.24, 56.73, -74.71, 55.08, -73.18, 53.43, -68.07, 49.93, -64.77, 47.26, -61.47, 44.59, -56.85, 41.15, -54.93, 39.06, -53.01, 36.97, -53.58, 36.33, -53.23, 34.73, -52.89, 33.13, -52.57, 31.18, -52.86, 29.45, -53.14, 27.72, -54.11, 26.43, -54.93, 24.36, -55.75, 22.29, -57.76, 17.01, -57.76, 17.01, -58.95, 13.9, -61.49, 10.54, -62.09, 5.7, -62.69, 0.86, -62.78, -6.42, -61.33, -12.01, -59.89, -17.61, -57.03, -23.34, -53.42, -27.85, -49.81, -32.36, -44.97, -36.44, -39.67, -39.08, -34.36, -41.72, -26.89, -42.35, -21.95, -42.92, -17.02, -43.5, -12.82, -42.23, -10.08, -42.55, -7.35, -42.86, -6.99, -43.29, -5.56, -44.81, -4.13, -46.33, -2.42, -49.15, -1.51, -51.66, -0.6, -54.18, -0.41, -56.28, -0.1, -59.89, 0.22, -63.49, -0.7, -71.11, 0.37, -73.27, 1.45, -75.44, 4.45, -72.99, 6.35, -72.88, 8.26, -72.77, 11.38, -71.7, 15.42, -69.41, 19.46, -67.12, 26.45, -63.89, 30.61, -59.13, 34.78, -54.37, 38.21, -46.32, 40.41, -40.85, 42.61, -35.38, 43.08, -31.87, 43.8, -26.34, 44.53, -20.81, 43.96, -13.05, 44.75, -7.68, 45.53, -2.31, 47.16, 2.25, 48.51, 5.89, 49.87, 9.53, 50.93, 11.42, 52.85, 14.18, 54.76, 16.95, 57.78, 20.59, 60.01, 22.48, 62.24, 24.36, 64.28, 24.68, 66.23, 25.49, 68.17, 26.31, 70.12, 27.06, 71.69, 27.38, 73.26, 27.69, 76.24, 26.75, 76.21, 28.51)
'
'** 千鳥の足のベジェ曲線データ
varBz2 = Array( _
12.17, 0#, 11.34, 1.46, 8.03, 0.04, 6.39, 0.75, 4.76, 1.45, 3.68, 3.06, 2.35, 4.23, 1.02, 5.39, -1.21, 8.26, -2.53, 8.68, -3.86, 9.1, -6.25, 8.48, -5.59, 6.74, -4.94, 5#, 1.15, -0.54, 1.4, -1.75, 1.65, -2.96, -2.05, -1.34, -4.09, -0.5, -6.13, 0.33, -9.47, 3.16, -10.84, 3.25, -12.21, 3.33, -13.78, 1.64, -12.34, 0#, -10.9, -1.65, -6.52, -5.29, -2.19, -6.62, 2.14, -7.96, 8.99, -9.1, 11.39, -8#, 13.78, -6.9, 13#, -1.46, 12.17, 0#)
'
'*ベジェ曲線データ設定(千鳥の身体)
ReDim sngBB1(UBound(varBz1, 1) \ 2, 1), _
sngBD1(UBound(varBz1, 1) \ 2, 1)
For Kp = LBound(sngBB1, 1) To UBound(sngBB1, 1)
sngBB1(Kp, 0) = CSng(varBz1(Kp * 2 + 0)) * CHIDBZM1 * -1
sngBB1(Kp, 1) = CSng(varBz1(Kp * 2 + 1)) * CHIDBZM1 * -1
If Kp = LBound(sngBB1, 1) Then
sngLT1(0) = sngBB1(Kp, 0): sngLT1(1) = sngBB1(Kp, 1)
Else
If sngLT1(0) > sngBB1(Kp, 0) Then sngLT1(0) = sngBB1(Kp, 0)
If sngLT1(1) > sngBB1(Kp, 1) Then sngLT1(1) = sngBB1(Kp, 1)
End If
Next Kp
'*ベジェ曲線データ設定(千鳥の足)
ReDim sngBB2(UBound(varBz2, 1) \ 2, 1), _
sngBD2(UBound(varBz2, 1) \ 2, 1)
For Kp = LBound(sngBB2, 1) To UBound(sngBB2, 1)
sngBB2(Kp, 0) = CSng(varBz2(Kp * 2 + 0)) * CHIDBZM2 * -1
sngBB2(Kp, 1) = CSng(varBz2(Kp * 2 + 1)) * CHIDBZM2 * -1
Next Kp
lngCol(0) = vbBlack '←輪郭の線色
lngCol(1) = vbYellow '←身体の色
lngCol(2) = vbWhite '←目などの色
For Jp = 0 To CHIDROWS - 1
intDyp = CHIDTOPP + CHIDHSPC * Jp
For Ip = 0 To CHIDCOLS - IIf((Jp Mod 2) = 0, 1, 2)
intDxp = CHIDLEFT + CHIDVSPC * Ip _
+ (CHIDVSPC / 2) * (Jp Mod 2)
'
intExp = intDxp + Abs(sngLT1(0))
intEyp = intDyp + Abs(sngLT1(1))
For Kp = LBound(sngBB1, 1) To UBound(sngBB1, 1)
sngBD1(Kp, 0) = sngBB1(Kp, 0) + intExp
sngBD1(Kp, 1) = sngBB1(Kp, 1) + intEyp
Next Kp
'*ベジェ曲線描画(千鳥の身体)
With ActiveDocument.Shapes.AddCurve(sngBD1)
.Line.ForeColor.RGB = lngCol(0)
.Fill.ForeColor.RGB = lngCol(1)
.Line.Weight = CHIDLNWE
End With
'
For Lp = 1 To 2
For Kp = LBound(sngBB2, 1) To UBound(sngBB2, 1)
sngBD2(Kp, 0) = sngBB2(Kp, 0) + intExp _
+ Choose(Lp, CHIDLFDX, CHIDRFDX)
sngBD2(Kp, 1) = sngBB2(Kp, 1) + intEyp _
+ Choose(Lp, CHIDLFDY, CHIDRFDY)
Next Kp
'*ベジェ曲線描画(千鳥の足)
With ActiveDocument.Shapes.AddCurve(sngBD2)
.Line.ForeColor.RGB = lngCol(0)
.Fill.ForeColor.RGB = lngCol(1)
.Line.Weight = CHIDLNWE
.Rotation = Choose(Lp, 15, 45)
End With
Next Lp
'円形描画(千鳥の目玉)
With ActiveDocument.Shapes.AddShape( _
msoShapeOval, _
intExp + CHIDEYDX - CHIDEYSZ / 2, _
intEyp + CHIDEYDY - CHIDEYSZ / 2, _
CHIDEYSZ, CHIDEYSZ)
.Fill.ForeColor.RGB = lngCol(2)
.Line.ForeColor.RGB = lngCol(0)
.Line.Weight = CHIDLNWE
End With
'三日月描画(千鳥の胸)
With ActiveDocument.Shapes.AddShape( _
msoShapeMoon, _
intExp + CHIDBSDX, _
intEyp + CHIDBSDY, _
CHIDBSWD, CHIDBSHT)
.Fill.ForeColor.RGB = lngCol(2)
.Line.ForeColor.RGB = lngCol(0)
.Line.Weight = CHIDLNWE
.Rotation = 210
.Adjustments(1) = 0.3
End With
Next Ip
Next Jp
End Sub
