【Word VBA】へのへのもへじ描画マクロ▽ソースコード
記事IT・テクノロジー
Option Explicit
Option Base 0
'
Public Sub へのへのもへじ描画マクロ()
Const HENOCNXP = 150 '描画中心位置（Ｘ）
Const HENOCNYP = 150 ' （Ｙ）
'
Const HENOBHEH = 5 '<へ>ベジェ横倍率
Const HENOBHEV = 5 ' 縦
Const HENOBNOH = 5 '<の>ベジェ横倍率
Const HENOBNOV = 5 ' 縦
Const HENOBMOH = 5 '<も>ベジェ横倍率
Const HENOBMOV = 8 ' 縦
Const HENOBJIH = 30 '<じ>ベジェ横倍率
Const HENOBJIV = 18 ' 縦
''
' '中心位置から
Const HENOHEHL = 20 '〃<へ>の距離[横
Const HENOHEVL = -20 ' [縦
Const HENONOVL = 0 '〃<の>の距離[縦
Const HENOMOHL = 0 '〃<も>の距離[横
Const HENOMOVL = 20 ' [縦
Const HENOMOLX = -10 '〃<も>の線距離
Const HENOMOLY = 12 ' [縦
Const HENOMOLG = 7 '<も>の線間隔
Const HENOMOLN = 14 '<も>の線長さ
Const HENOHDHL = 5 '〃<へ>の距離[横
Const HENOHDVL = 65 ' [縦
Const HENOJIHL = -12 '〃<じ>の距離[横
Const HENOJIVL = 25 ' [縦
Const HENOJILX = 35 '〃<じ>の線距離
Const HENOJILY = 32 ' [縦
Const HENOJILG = 7 '<じ>の線間隔
Const HENOJILN = 10 '<じ>の線長さ
'
Const HENOLNCL = &H696969 '線の色
Const HENOLNWT = 3.5 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim varBzHe As Variant, varBzNo As Variant
Dim varBzMo As Variant, varBzJi As Variant
Dim sngBBHe() As Single, sngBDHe() As Single
Dim sngBBNo() As Single, sngBDNo() As Single
Dim sngBBMo() As Single, sngBDMo() As Single
Dim sngBBJi() As Single, sngBDJi() As Single
'
varBzHe = Array(-2.93, -0.14, -2.51, -1.14, -2.23, -1.89, _
-1.89, -2.86, -0.19, -2.2, 1.39, -1.33, 3.04, -0.02) 'へ
varBzNo = Array(-0.11, -2.92, -0.01, -1.05, -0.16, 0.48, _
-0.69, 1.98, -1.61, 1.98, -2.31, 0.95, -1.84, -1.23, -1.63, _
-1.98, -0.94, -2.86, -0.08, -2.98, 0.69, -2.98, 1.33, -2.27, _
1.64, -1.36, 2.08, -0.3, 1.73, 1.52, 1.06, 2.05) 'の
varBzMo = Array(0.08, -3.89, -0.56, -1.83, -0.79, 0.11, -0.56, _
1.86, -0.16, 3.58, 0.86, 3.33, 1.04, 1.08) 'も
varBzJi = Array(-0.58, -4.92, -1.68, -1.7, -1.84, 1.11, -0.93, _
2.48, 0.08, 3.86, 1.44, 2.67, 1.76, 1.17) 'し
'
'<へ>ベジェ曲線データ
ReDim sngBBHe((UBound(varBzHe, 1) - 1) \ 2, 1)
ReDim sngBDHe((UBound(varBzHe, 1) - 1) \ 2, 1)
For Kp = LBound(sngBBHe, 1) To UBound(sngBBHe, 1)
sngBBHe(Kp, 0) = CSng(varBzHe(Kp * 2 + 0)) * HENOBHEH
sngBBHe(Kp, 1) = CSng(varBzHe(Kp * 2 + 1)) * HENOBHEV
Next Kp
'<の>ベジェ曲線データ
ReDim sngBBNo((UBound(varBzNo, 1) - 1) \ 2, 1)
ReDim sngBDNo((UBound(varBzNo, 1) - 1) \ 2, 1)
For Kp = LBound(sngBBNo, 1) To UBound(sngBBNo, 1)
sngBBNo(Kp, 0) = CSng(varBzNo(Kp * 2 + 0)) * HENOBNOH
sngBBNo(Kp, 1) = CSng(varBzNo(Kp * 2 + 1)) * HENOBNOV
Next Kp
'<も>ベジェ曲線データ/横線無し
ReDim sngBBMo((UBound(varBzMo, 1) - 1) \ 2, 1)
ReDim sngBDMo((UBound(varBzMo, 1) - 1) \ 2, 1)
For Kp = LBound(sngBBMo, 1) To UBound(sngBBMo, 1)
sngBBMo(Kp, 0) = CSng(varBzMo(Kp * 2 + 0)) * HENOBMOH
sngBBMo(Kp, 1) = CSng(varBzMo(Kp * 2 + 1)) * HENOBMOV
Next Kp
''<し>ベジェ曲線データ
ReDim sngBBJi((UBound(varBzJi, 1) - 1) \ 2, 1)
ReDim sngBDJi((UBound(varBzJi, 1) - 1) \ 2, 1)
For Kp = LBound(sngBBJi, 1) To UBound(sngBBJi, 1)
sngBBJi(Kp, 0) = CSng(varBzJi(Kp * 2 + 0)) * HENOBJIH
sngBBJi(Kp, 1) = CSng(varBzJi(Kp * 2 + 1)) * HENOBJIV
Next Kp
'<への><への>描画
For Ip = 1 To 2
'<へ>描画
intDxp = HENOCNXP + HENOHEHL * Choose(Ip, -1, 1)
intDyp = HENOCNYP + HENOHEVL
For Kp = LBound(sngBDHe, 1) To UBound(sngBDHe, 1)
sngBDHe(Kp, 0) = sngBBHe(Kp, 0) + intDxp
sngBDHe(Kp, 1) = sngBBHe(Kp, 1) + intDyp
Next Kp
With ActiveDocument.Shapes.AddCurve(sngBDHe)
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = HENOLNCL
.Line.Weight = HENOLNWT
End With
'<の>描画
intDxp = HENOCNXP + HENOHEHL * Choose(Ip, -1, 1)
intDyp = HENOCNYP + HENONOVL
For Kp = LBound(sngBDNo, 1) To UBound(sngBDNo, 1)
sngBDNo(Kp, 0) = sngBBNo(Kp, 0) + intDxp
sngBDNo(Kp, 1) = sngBBNo(Kp, 1) + intDyp
Next Kp
With ActiveDocument.Shapes.AddCurve(sngBDNo)
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = HENOLNCL
.Line.Weight = HENOLNWT
End With
Next Ip
'
'<も>描画
intDxp = HENOCNXP + HENOMOHL
intDyp = HENOCNYP + HENOMOVL
For Kp = LBound(sngBDMo, 1) To UBound(sngBDMo, 1)
sngBDMo(Kp, 0) = sngBBMo(Kp, 0) + intDxp
sngBDMo(Kp, 1) = sngBBMo(Kp, 1) + intDyp
Next Kp
With ActiveDocument.Shapes.AddCurve(sngBDMo)
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = HENOLNCL
.Line.Weight = HENOLNWT
End With
'<も>の＝描画
For Ip = 0 To 1
intDxp = HENOCNXP + HENOMOLX
intDyp = HENOCNYP + HENOMOLY _
+ HENOMOLG * Ip
With ActiveDocument.Shapes.AddLine( _
intDxp, intDyp, _
intDxp + HENOMOLN, intDyp).Line
.ForeColor.RGB = HENOLNCL
.Weight = HENOLNWT
End With
Next Ip
'
'<へ>描画
intDxp = HENOCNXP + HENOHDHL
intDyp = HENOCNYP + HENOHDVL
For Kp = LBound(sngBDHe, 1) To UBound(sngBDHe, 1)
sngBDHe(Kp, 0) = sngBBHe(Kp, 0) + intDxp
sngBDHe(Kp, 1) = sngBBHe(Kp, 1) + intDyp
Next Kp
With ActiveDocument.Shapes.AddCurve(sngBDHe)
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = HENOLNCL
.Line.Weight = HENOLNWT
End With
'
'<じ>描画
intDxp = HENOCNXP + HENOJIHL
intDyp = HENOCNYP + HENOJIVL
For Kp = LBound(sngBDJi, 1) To UBound(sngBDJi, 1)
sngBDJi(Kp, 0) = sngBBJi(Kp, 0) + intDxp
sngBDJi(Kp, 1) = sngBBJi(Kp, 1) + intDyp
Next Kp
With ActiveDocument.Shapes.AddCurve(sngBDJi)
.Fill.Visible = msoFalse
.Line.ForeColor.RGB = HENOLNCL
.Line.Weight = HENOLNWT
End With
'<じ>の〃描画
For Ip = 0 To 1
intDxp = HENOCNXP + HENOJILX
intDyp = HENOCNYP + HENOJILY _
+ HENOJILG * Ip
With ActiveDocument.Shapes.AddLine( _
intDxp, intDyp, _
intDxp + HENOJILN, _
intDyp).Line
.ForeColor.RGB = HENOLNCL
.Weight = HENOLNWT
End With
Next Ip
End Sub
