【Word VBA】四角と矢印模様描画マクロ▽ソースコード
記事IT・テクノロジー
ption Explicit
Option Base 0
'
Public Sub 四角と矢印模様描画マクロ()
Const SQARLEFT = 80 '描画開始位置Ｘ
Const SQARTOPP = 90 ' Ｙ
'
Const SQARCOLS = 6 '横/描画数
Const SQARROWS = 4 '縦/描画数
'
Const SQARSIZE = 20 '描画サイズ
Const SQARSGAP = 2 '描画隙間
'
'縦横/描画間隔
Const SQARVPIT = ((SQARSIZE + SQARSGAP) * 2)
Const SQARHPIT = ((SQARSIZE + SQARSGAP) * 2)
'
Const SQARLNWE = 1.5 '線の太さ
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim intDxp As Integer, intDyp As Integer
Dim lngCol As Long
'
Randomize '*乱数系列初期化
lngCol = RGB(65, 105, 225) '←塗りつぶし色
For Jp = 0 To SQARROWS - 1
intDyp = SQARTOPP + SQARHPIT * Jp
For Ip = 0 To SQARCOLS - 1
intDxp = SQARLEFT + SQARVPIT * Ip
'*四角形描画
With ActiveDocument.Shapes.AddShape( _
msoShapeRectangle, intDxp, intDyp, _
SQARSIZE, SQARSIZE)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = lngCol
.Line.Visible = msoFalse
End With
'*左右矢印描画(左右の向きは乱数による)
If Ip < SQARCOLS - 1 Then
With ActiveDocument.Shapes.AddShape( _
IIf(Int(Rnd * 2) = 0, msoShapeRightArrow, _
msoShapeLeftArrow), _
intDxp + SQARSIZE + SQARSGAP, _
intDyp, _
SQARSIZE, SQARSIZE)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = lngCol
.Line.Visible = msoFalse
End With
End If
'上下矢印描画(上下の向きは乱数による)
If Jp < SQARROWS - 1 Then
With ActiveDocument.Shapes.AddShape( _
IIf(Int(Rnd * 2) = 0, msoShapeUpArrow, _
msoShapeDownArrow), _
intDxp, _
intDyp + SQARSIZE + SQARSGAP, _
SQARSIZE, SQARSIZE)
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = lngCol
.Line.Visible = msoFalse
End With
End If
Next Ip
Next Jp
End Sub
