VBA: 円状にランダムに点を打つマクロ

Visio 上で,指定した座標を中心にランダムに点を打つマクロ.なおここでは,使用イメージのように点の密度が中央に偏るようにしている.



なお,Excel 関数の標準正規分布関数 NormSInv を使用するため,VBA から Excel オブジェクトライブラリを参照するために,あらかじめ以下の操作が必要.
(1) Visio にて,[ツール] → [マクロ] → 「Visial Basic Editor」を開く.
(2) Visual Basic Editor にて,[ツール] → [参照設定] → 「Microsoft Excel 9.0 Object Library」を選択 → [OK]
(*) その後,コードを編集し,保存.

使い方は,「実行するマクロ」内の値を適当に修正し,[ツール] → [マクロ] から「実行するマクロ」を実行.
※なぜ「drawPoints」を別のプロージャ(「実行するマクロ」)から呼び出しているかというと,引数を変えた複数の drawPoints を同時に実行できるようにするため.

[vb]
Sub 実行するマクロ()
drawPoints 100, 100, 1000, 50
End Sub

Sub drawPoints(x, y, n, r)
'x = 中心のX座標
'y = 中心のY座標
'n = 描画する点の個数
'r = 点の散らばる範囲を調整する値

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Microsoft Excel 9.0 Object Library を参照
Dim objExcel As Excel.Application
Set objExcel = CreateObject("Excel.Application")

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim myCircle() As Visio.Shape
'配列生成時に変数(ここでの n )を利用できないため ReDim を使用
ReDim myCircle(n)

i = 0
Do While i < n
drawX = x + objExcel.Application.NormSInv(Rnd) * r
drawY = y + objExcel.Application.NormSInv(Rnd) * r

'※描画する点の大きさは 2 に固定.手抜き...
drawX1 = drawX - 1
drawX2 = drawX + 1
drawY1 = drawY + 1
drawY2 = drawY - 1

'点を描画
Set myCircle(i) = ThisDocument.Application.ActiveWindow.Page.DrawOval(drawX1, drawY1, drawX2, drawY2)
'塗りつぶし色を変更
myCircle(i).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(0,32,96))"
'透過度を変更
'myCircle(i).CellsSRC(visSectionObject, visRowFill, visFillForegndTrans).FormulaU = "50%"
'線をなしにする
myCircle(i).CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "0"
'レイヤを変更する
'myCircle(i).CellsSRC(visSectionObject, visRowLayerMem, visLayerMember).FormulaForceU = """5"""

'カウンタを進める
i = i + 1
Loop

'ReDim したオブジェクトは Erase するお約束(?)
Erase myCircle()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
[/vb]

Artikel Terkait

Emoji Emoji

注: コメントを投稿できるのは、このブログのメンバーだけです。