【Word VBA】乱数を使ったモンドリアン風模様描画マクロ▽ソースコード
記事IT・テクノロジー
Option Explicit
Option Base 0
'
Public Sub 乱数を使ったモンドリアン風模様描画マクロ()
Const MODRLEFT = 90 '描画開始位置Ｘ
Const MODRTOPP = 80 ' Ｙ
'
Const MODRWIDT = 200 '描画幅
Const MODRHEIG = 200 '描画高さ
'
Const MODRCOLS = 5 '最小マス数（横）
Const MODRROWS = 5 '最小マス数（縦）
'
Const MODRLNWE = 10 '線の太さ
'
Const MODRCLLM = 3 '色エリアの最大値
'---------------------------------------------------------------------------
Dim Ip As Integer, Jp As Integer
Dim Kp As Integer
Dim intLnH(MODRCOLS) As Integer
Dim intLnV(MODRROWS) As Integer
Dim intRct(MODRCOLS - 1, MODRROWS - 1, 4) As Integer
Dim lngCol(3) As Long, intCcn(3) As Integer
'
'*縦横の幅を乱数により設定
Randomize '*乱数系列初期化
intLnV(MODRCOLS) = 0 '←垂直ラインの幅を設定
For Ip = 0 To MODRCOLS - 1
intLnV(Ip) = CInt((Rnd + 1) * 100)
intLnV(MODRCOLS) = intLnV(MODRCOLS) + intLnV(Ip)
Next Ip
For Ip = 0 To MODRCOLS - 1
intLnV(Ip) = CInt(((intLnV(Ip)) / intLnV(MODRCOLS)) _
* MODRWIDT)
Next Ip
'
intLnH(MODRROWS) = 0 '←水平ラインの幅を設定
For Ip = 0 To MODRROWS - 1
intLnH(Ip) = CInt((Rnd + 1) * 100)
intLnH(MODRROWS) = intLnH(MODRROWS) + intLnH(Ip)
Next Ip
For Ip = 0 To MODRROWS - 1
intLnH(Ip) = CInt(((intLnH(Ip)) / intLnH(MODRROWS)) _
* MODRHEIG)
Next Ip
'
lngCol(0) = vbWhite: lngCol(1) = vbBlue
lngCol(2) = vbRed: lngCol(3) = vbYellow
For Ip = 0 To 3: intCcn(Ip) = 0: Next Ip '←色カウントクリア
'
'*最小マスの位置、サイズ設定
intLnH(MODRROWS) = 0 + MODRTOPP
For Jp = 0 To MODRROWS - 1
intLnV(MODRCOLS) = 0 + MODRLEFT
For Ip = 0 To MODRCOLS - 1
intRct(Ip, Jp, 0) = intLnV(MODRCOLS) '←X
intRct(Ip, Jp, 1) = intLnH(MODRROWS) '←Y
intRct(Ip, Jp, 2) = intLnV(Ip) '←Width
intRct(Ip, Jp, 3) = intLnH(Jp) '←Height
intRct(Ip, Jp, 4) = 0 '←Fill
intLnV(MODRCOLS) = intLnV(MODRCOLS) + intLnV(Ip)
Next Ip
intLnH(MODRROWS) = intLnH(MODRROWS) + intLnH(Jp)
Next Jp
'
'*ランダムにマスを連結
For Jp = 0 To MODRROWS - 1
For Ip = 0 To MODRCOLS - 1
If intRct(Ip, Jp, 0) >= MODRLEFT Then
Kp = Int(Rnd * 10) '←乱数(0--9)
'1--3:横に連結
If (Kp >= 1 And Kp <= 3) And Ip < MODRCOLS - 1 Then
intRct(Ip + 1, Jp, 0) = -1
intRct(Ip, Jp, 2) = intRct(Ip, Jp, 2) _
+ intRct(Ip + 1, Jp, 2)
End If
'4--6:縦に連結
If (Kp >= 4 And Kp <= 6) And Jp < MODRROWS - 1 Then
intRct(Ip, Jp + 1, 0) = -1
intRct(Ip, Jp, 3) = intRct(Ip, Jp, 3) _
+ intRct(Ip, Jp + 1, 3)
End If
'塗りつぶし色設定
Select Case Kp
Case 2, 5:
If intCcn(1) < MODRCLLM Then _
intRct(Ip, Jp, 4) = 1: intCcn(1) = intCcn(1) + 1
Case 3, 4:
If intCcn(2) < MODRCLLM Then _
intRct(Ip, Jp, 4) = 2: intCcn(2) = intCcn(2) + 1
Case 7, 8:
If intCcn(3) < MODRCLLM Then _
intRct(Ip, Jp, 4) = 3: intCcn(3) = intCcn(3) + 1
End Select
End If
Next Ip
Next Jp
'
'作成したデータにより描画
For Jp = 0 To MODRROWS - 1
For Ip = 0 To MODRCOLS - 1
If intRct(Ip, Jp, 0) >= MODRLEFT Then
'*四角形描画
With ActiveDocument.Shapes.AddShape(msoShapeRectangle, _
intRct(Ip, Jp, 0), intRct(Ip, Jp, 1), _
intRct(Ip, Jp, 2), intRct(Ip, Jp, 3))
.Fill.Visible = msoTrue
.Fill.ForeColor = _
lngCol(intRct(Ip, Jp, 4)) '←塗りつぶし色
.Line.Visible = msoTrue
.Line.ForeColor.RGB = vbBlack '←線色
.Line.Weight = MODRLNWE '←線の太さ
End With
End If
Next Ip
Next Jp
End Sub
《蛇足》
作者に能力とセンスがあれば、もっとピート・モンドリアン（オランダの画家:1872/03/07 - 1944/02/01）の抽象画に近づけたと思いますが・・・。
乱数を使用しているので、実行の度、模様が変わります。
