Option Explicit
Option Base 0
Public Sub 風鈴描画マクロ()
Const WIBLLEFT = 100 '描画開始位X
Const WIBLTOPP = 80 '_____Y
Const WINBUPLN = 30 '吊るす紐の長さ
Const WINBBWID = 70 '本体幅
Const WINBBHEI = 45 '本体高さ
'
Const WINBHWID = 25 '本体底穴幅
Const WINBHHEI = 10 '本体底穴高さ
Const WINBHPOS = 32 '本体底穴位置
'
Const WINBWWID = 6 '本体中の錘幅
Const WINBWHEI = 4 '本体中の錘高さ
Const WINBWPOS = 33 '本体中の錘位置
'
Const WINBDWLN = 30 '本体と短冊長さ
'
Const WINBTWID = 40 '短冊幅
Const WINBTHEI = 80 '短冊長さ
Const WINBTWAV = 0.2 '短冊うねり
'
Const WINBCONT = 3 '描画数
Const WINBSPAC = 15 '横間隔
Const WINBLNWE = 1 '輪郭太さ
'---------------------------------------------------------------------------
Dim Ip As Integer
Dim intDxp As Integer, intDyp As Integer
Dim lngclOl As Long
'
lngclOl = vbBlack '←線色
For Ip = 0 To WINBCONT - 1
intDxp = WIBLLEFT + (WINBBWID + WINBSPAC) * Ip _
+ WINBBWID \ 2
intDyp = WIBLTOPP
With ActiveDocument.Shapes.AddLine(intDxp, intDyp, _
intDxp, intDyp + WINBUPLN).Line
.ForeColor.RGB = lngclOl
.Weight = WINBLNWE
End With
intDyp = intDyp + WINBUPLN
With ActiveDocument.Shapes.AddShape(msoShapeOval, _
intDxp - WINBBWID \ 2, intDyp, _
WINBBWID, WINBBHEI)
.Fill.ForeColor.RGB = _
Choose((Ip Mod 3) + 1, vbCyan, vbGreen, vbYellow)
.Line.ForeColor.RGB = lngclOl
.Line.Weight = WINBLNWE
End With
With ActiveDocument.Shapes.AddShape(msoShapeOval, _
intDxp - WINBHWID \ 2, intDyp + WINBHPOS, _
WINBHWID, WINBHHEI)
.Fill.ForeColor.RGB = RGB(105, 105, 105)
.Line.ForeColor.RGB = lngclOl
.Line.Weight = WINBLNWE
End With
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intDxp - WINBWWID \ 2, intDyp + WINBWPOS, _
WINBWWID, WINBWHEI)
.Fill.ForeColor.RGB = RGB(255, 165, 0)
.Line.ForeColor.RGB = lngclOl
.Line.Weight = WINBLNWE
End With
'
intDyp = intDyp + WINBWPOS
With ActiveDocument.Shapes.AddLine(intDxp, intDyp, _
intDxp, intDyp + WINBDWLN).Line
.ForeColor.RGB = lngclOl
.Weight = WINBLNWE
End With
'
intDyp = intDyp + WINBDWLN
With ActiveDocument.Shapes.AddShape(msoShapeWave, _
intDxp - WINBTHEI \ 2, _
intDyp + WINBTHEI \ 2 - WINBTWID \ 2, _
WINBTHEI, WINBTWID)
.Fill.ForeColor.RGB = _
Choose((Ip Mod 3) + 1, vbGreen, vbYellow, vbCyan)
.Line.ForeColor.RGB = lngclOl
.Adjustments(1) = WINBTWAV
.Rotation = 90
End With
Next Ip
End Sub