図形の位置を取得・設定する方法

VisioBAで書式の取得設定をしよう VBA

あれ、この図形少し右に設定したいのだけど、なんか上手くいかない

Visioって位置の表現方法にちょっとクセがあるんだけど、
そこさえ押さえれば簡単だよ

Visioでは図形の位置(X座標やY座標)を簡単に取得したり設定できます。
今回は、Visio VBAで図形の位置を操作する方法を分かりやすくご紹介します!

位置の表現方法について

Visio図形の座標についてご存じの方はとばしてください。

座標について

Visioで図形の位置を操作するとき、座標は「ページ内の位置」で指定されます。
通常、左下が(0, 0)で、右上がページサイズに応じた値になります。

  • 単位の注意点:
    Visioの標準単位は「インチ (inch)」。ただし、使いやすくするために「mm」や「pt」などに変換することも可能です。

インチなのか、変換できないの?

こんな感じで変換できるよ

例えば・・・

図形.Cells("PinX").Result("mm") ' X座標をミリメートルで取得
図形.Cells("PinY").Result("mm") ' Y座標をミリメートルで取得

とか、

xPosCM = Visio.Application.ConvertResult(Xpos, "in", "cm") 
xPosFT = Visio.Application.ConvertResult(Xpos, "in", "ft")

図形の位置指定について詳しくはこちらを参照ください。

位置の基準点について

ところでこの位置座標って四角形の中のどこを指しているの???

位置情報の基準点(LockPinX,LockPinY)っていうのがあるんだ

Officeの中でもVisio独特だと思うのですが、位置座標の基準点というのがあって図形それぞれに基準点を設定することができるんです。基準点(LockPinX,LockPinY)は初期値では図形の真ん中にあります。

例えば・・・Visioの中である四角形の位置座標が(5,5)だったとします。

基準点(LockPinX , LockPinY)の位置が、初期値の(Width*0.5 , Height*0.5)であればこうなります。

基準点(LockPinX , LockPinY)の位置が、初期値の(Width*0.5 , Height*0.5)であればこうなります。

基準点(LockPinX,LockPinY)の位置を(0,0)に設定すると、こうなります。

詳しくはこちらの記事を参照下さい。

図形の位置を取得する方法

図形の位置を取得するには、PinX(X座標)とPinY(Y座標)のセルを参照します。

さて本題!!

構文

Visio VBAで座標(xPos , yPos)を取得する構文はこちら。

xPos = 図形.Cells(“PinX”).Result(“mm”)
yPos = 図形.Cells(“PinY”).Result(“mm”)

Sample

選択中の図形の位置座標を取得するサンプルです。
何かしら図形を選択しておいてください。

コード

Sub test1()

Dim xPos As Double, yPos As Double

' 選択中の図形から位置を取得
xPos = ActiveWindow.Selection(1).Cells("PinX").Result("mm")
yPos = ActiveWindow.Selection(1).Cells("PinY").Result("mm")

' メッセージボックスで表示
MsgBox "X座標: " & xPos & " mm" & vbCrLf & "Y座標: " & yPos & " mm"

End Sub

実行結果

選択した図形の座標がメッセージボックスに表示されます。

図形の位置を設定する方法

図形の位置を設定するには、PinXPinYセルに値を代入します。

今度は移動させるよ!

構文

Visio VBAで任意の図形の位置を変更する構文はこちら。

図形.Cells(“PinX”).Result(“mm”) = X座標
図形.Cells(“PinY”).Result(“mm”) = Y座標

Sample

選択中の図形を指定した位置に移動する例を紹介します。

コード

Sub test2()

' X座標とY座標を指定
Dim newX As Double, newY As Double
newX = 50 ' mm単位
newY = 220 ' mm単位

' 図形の位置を設定
ActiveWindow.Selection(1).Cells("PinX").Result("mm") = newX
ActiveWindow.Selection(1).Cells("PinY").Result("mm") = newY

MsgBox "位置を変更しました!"

End Sub

実行結果

選択した図形が新しい位置に移動したと思います。

ちょっと動かせそうな気がしてきた。

ワンクリックで5mm動くボタンとかあったら便利なときもあるかも。

タイトルとURLをコピーしました