【Word VBA】アイヌ文様描画マクロ▽ソースコード
記事IT・テクノロジー
Option Explicit
Option Base 0
'
Public Sub アイヌ文様描画マクロ()
Const AINULEFT = 150 '描画開始位置Ｘ
Const AINUTOPP = 120 ' Ｙ
'
Const AINUBZMG = -1.5 'ベジエ曲線倍率
Const AINULNWT = 1 '輪郭線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Kp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim sngBBas() As Single, sngBDat() As Single
Dim sngMax(1) As Single, sngMin(1) As Single
Dim varBezi As Variant, lngCol(1) As Long
'
'ベジエデータ
varBezi = Array(20.7, 19.05, 24#, 16.2, 28.2, 12.3, 30.75, 7.2, _
33.6, 2.1, 35.25, -4.05, 35.55, -11.1, 35.55, -16.35, _
34.05, -20.85, 32.85, -24.15, 31.35, -27.45, 29.85, -29.25, _
28.05, -31.2, 25.95, -33.15, 23.85, -34.5, 21.45, -36#, _
18.9, -37.5, 13.35, -40.35, 12.75, -40.05, 12.15, -39.75, _
16.2, -36.45, 17.85, -34.05, 19.35, -31.5, 21.45, -29.1, _
22.35, -25.65, 23.4, -22.35, 24#, -17.25, 23.7, -13.5, _
23.4, -9.75, 22.65, -6#, 21.15, -2.85, 19.05, 0.3, _
17.4, 3.15, 13.95, 6.15, 9.9, 8.25, 7.35, 9.6, _
3.75, 9.75, 0.75, 10.05, -3.45, 10.05, -6.15, 8.85, _
-9.45, 7.2, -11.85, 4.35, -12.75, 1.8, -13.8, -0.75, _
-13.65, -4.05, -12.45, -6.45, -11.1, -8.85, -7.95, -11.4, _
-5.4, -12.3, -2.7, -13.2, 0.9, -13.2, 3.6, -11.25, _
5.7, -8.4, 4.95, -5.85, 4.2, -3.9, 3.6, -1.95, _
-0.15, -0.75, -0.3, -0.15, -0.45, 0.6, 1.65, 0.75, _
3.45, 0.15, 4.95, -0.3, 8.25, -1.5, 9.75, -2.85, _
11.25, -4.2, 11.85, -6#, 12.45, -7.8, 12.9, -9.6, _
13.05, -11.85, 12.75, -14.25, 12.3, -15.75, 12.15, -17.7, _
10.2, -20.4, 7.8, -22.65, 4.65, -24.3, 1.65, -25.2, _
-1.65, -25.65, -4.65, -25.95, -7.8, -25.05, -11.4, -24.6, _
-15.6, -22.65, -18.15, -20.4, -20.85, -18.15, -22.65, -16.05, _
-24.15, -12.45, -25.65, -7.8, -26.55, -0.9, -24.75, 4.65, _
-23.1, 9.3, -21#, 11.85, -19.05, 14.25, -16.95, 16.5, _
-14.7, 17.85, -11.85, 19.05, -10.05, 19.35, -7.05, 19.05, _
6.3, 19.05, 17.55, 19.05, 20.1, 19.05, 20.1, 19.05)
'
'ベジェ曲線設定
ReDim sngBBas(UBound(varBezi, 1) \ 2, 1)
ReDim sngBDat(UBound(varBezi, 1) \ 2, 1)
For Kp = LBound(sngBBas, 1) To UBound(sngBBas, 1)
sngBBas(Kp, 0) = CSng(varBezi(Kp * 2 + 0)) * AINUBZMG
sngBBas(Kp, 1) = CSng(varBezi(Kp * 2 + 1)) * AINUBZMG
'配置位置のために、左右上下位置取得
If Kp = LBound(sngBBas, 1) Then
sngMin(0) = sngBBas(Kp, 0): sngMin(1) = sngBBas(Kp, 1)
sngMax(0) = sngBBas(Kp, 0): sngMax(1) = sngBBas(Kp, 1)
Else
If sngMin(0) > sngBBas(Kp, 0) Then sngMin(0) = sngBBas(Kp, 0)
If sngMin(1) > sngBBas(Kp, 1) Then sngMin(1) = sngBBas(Kp, 1)
If sngMax(0) < sngBBas(Kp, 0) Then sngMax(0) = sngBBas(Kp, 0)
If sngMax(1) < sngBBas(Kp, 1) Then sngMax(1) = sngBBas(Kp, 1)
End If
Next Kp
'
lngCol(0) = vbBlack '←線色
lngCol(1) = RGB(139, 0, 139) '←塗りつぶし色
For Ip = 0 To 3
intDxp = AINULEFT + (sngMax(0) - sngMin(0) - 2) * (Ip Mod 2)
intDyp = AINUTOPP + (sngMax(1) - sngMin(1) - 1) * (Ip \ 2)
'
For Kp = LBound(sngBBas, 1) To UBound(sngBBas, 1)
sngBDat(Kp, 0) = sngBBas(Kp, 0) + intDxp
sngBDat(Kp, 1) = sngBBas(Kp, 1) + intDyp
Next Kp
'ベジェ曲線描画
With ActiveDocument.Shapes.AddCurve(sngBDat)
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol(0) '←線色
.Line.Weight = AINULNWT
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = lngCol(1) '←塗りつぶし
Select Case Ip '↓場所によって反転
Case 0: .Flip msoFlipVertical
Case 1: .Flip msoFlipVertical
.Flip msoFlipHorizontal
Case 2:
Case 3: .Flip msoFlipHorizontal
End Select
End With
Next Ip
End Sub
