Option Explicit
Option Base 0
Public Sub 青海波描画マクロ()
Const BWAVLFT = 100 '描画開始位置Ｘ
Const BWAVTOP = 100 ' Ｙ
Const BWAVCOL = 6 '列数
Const BWAVROW = 8 '行数
Const BWAVRAD = 8 '半径間隔
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer, Kp As Integer
Dim iCxp As Integer, iCyp As Integer
Dim iRad As Integer
Dim iAng(1) As Integer, jAng(1) As Integer
'
For Ip = 0 To BWAVROW - 1
iCyp = BWAVLFT + (BWAVRAD * 3) + (BWAVRAD * 3 / 2) * Ip
'描画角度指定(最終行は半円)
If Ip < BWAVROW - 1 Then iAng(0) = -150: iAng(1) = -30 _
Else iAng(0) = -180: iAng(1) = -0
For Jp = 0 To BWAVCOL - 1
iCxp = BWAVTOP + (BWAVRAD * 6) * Jp _
+ (BWAVRAD * 3) * (Ip Mod 2)
'描画角度指定(左右端処理)
jAng(0) = IIf((Ip Mod 2) = 0 And Jp = 0, -90, iAng(0))
jAng(1) = IIf((Ip Mod 2) = 1 And Jp = BWAVCOL - 1, _
-90, iAng(1))
For Kp = 1 To 3
iRad = Kp * BWAVRAD
'円弧描画
With ActiveDocument.Shapes.AddShape(msoShapeBlockArc, _
iCxp - iRad, iCyp - iRad, iRad * 2, iRad * 2)
.Fill.Visible = True '←塗りつぶし有無
.Fill.ForeColor.RGB = vbBlue
.Line.Visible = False '←線描画有無
.Adjustments(1) = jAng(0) '←描画開始角度
.Adjustments(2) = jAng(1) '← 終了角度
.Adjustments(3) = 0.25 / Kp '←内外比
End With
Next Kp
Next Jp
Next Ip
End Sub
