Option Explicit
Option Base 0
'
Public Sub 鱗権太夫模様描画マクロ()
Const SCLGLEFT = 80 '描画開始位置Ｘ
Const SCLGTOPP = 90 ' Ｙ
'
Const SCLGTSIZ = 6 '三角形幅
'
Const SCLGTCN1 = 10 '大きな三角山段数
Const SCLGTCN2 = 4 '小さな三角山段数
'
'横-間隔
Const SCLGVSPC = (SCLGTSIZ * (SCLGTCN1 + 1))
'縦-間隔
Const SCLGHSPC = ((SCLGTSIZ / 2) * (SCLGTCN1 + 1))
'
Const SCLGCOLS = 3 '横/描画数
Const SCLGROWS = 4 '縦/描画数
'
Const SCLGLNWE = 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 As Long
'
lngCol = RGB(0, 0, 139) '←線色
For Jp = 0 To SCLGROWS - 1
intDyp = SCLGTOPP + SCLGHSPC * Jp
For Ip = 0 To SCLGCOLS - 1
intDxp = SCLGLEFT + (SCLGVSPC / 2) _
+ SCLGVSPC * Ip _
+ (SCLGVSPC / 2) * (Jp Mod 2)
'*大きな三角山描画
For Kp = 0 To SCLGTCN1
intEyp = intDyp + Kp * (SCLGTSIZ / 2)
For Lp = 0 To Kp
intExp = intDxp _
- (SCLGTSIZ / 2) * Kp _
+ SCLGTSIZ * Lp
With ActiveDocument.Shapes.AddShape( _
msoShapeIsoscelesTriangle, _
intExp, intEyp, _
SCLGTSIZ, (SCLGTSIZ / 2))
.Fill.Visible = msoFalse
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol '←線色
.Line.Weight = SCLGLNWE '← ふとさ
End With
Next Lp
Next Kp
'*小さな三角山描画
For Kp = 0 To SCLGTCN2
intEyp = intDyp + Kp * (SCLGTSIZ / 2)
For Lp = 0 To Kp
intExp = intDxp + (SCLGVSPC / 2) _
- (SCLGTSIZ / 2) * Kp _
+ SCLGTSIZ * Lp
With ActiveDocument.Shapes.AddShape( _
msoShapeIsoscelesTriangle, _
intExp, intEyp, _
SCLGTSIZ, (SCLGTSIZ / 2))
.Fill.Visible = msoFalse
.Line.Visible = msoTrue
.Line.ForeColor.RGB = lngCol '←線色
.Line.Weight = SCLGLNWE '← ふとさ
End With
Next Lp
Next Kp
Next Ip
Next Jp
End Sub
《蛇足》描画に時間がかかります。
