Visio VBA で選択している図形の面積や長さを求める方法

Question

実現したいこと

Visio　Professional 2024を使い始めました。
以前のバージョン(Visio Professional 2021以前)では、[図形と面積と外周の長さ] というアドオンがあり、これを使うことで、選択している図形の長さや面積を求めることができました。複数の図形を選択している場合は、合計の長さ、合計の面積を求めることができました。
しかし、Visio Pro 2024 では仕様変更か、このアドオンが消えたようです。
そこで、Visio VBA を使って、同じ機能を実現できないかと画策しています。

発生している問題・分からないこと

Visio VBA で以下のコードを作ると、図面内にある1番目の図形の面積を求めることができます。
※仕様上、長さの値は「平方インチ」で出てくるので「cm^2」に換算するために 2.54^2倍しています。

Sub 面積の表示()
    MsgBox Round(ActivePage.Shapes(1).AreaIU * 2.54 ^ 2, 5) & "(cm^2)"
End Sub

以下のようにすれば図面内の全ての図形の面積の合計値を求めることができました。

Sub 合計面積の表示()
    Dim N As Long, i As Long, S As Double
    N = ActivePage.Shapes.Count
    S = 0
    
    For i = 1 To N
        S = S + ActivePage.Shapes(i).AreaIU * 2.54 ^ 2 '平方インチをcm^2に換算
    Next
    
    MsgBox Round(S, 5) & "(cm^2)"
End Sub

ところが、上記の方法で求めることができるのは、あくまでも「図面内の1番目の図形」や「図面内の全ての図形」の面積だけです。
沢山の図形が存在する図面内で「選択している図形の面積」を求めるにはどうすれば良いでしょうか?
(なお、複数の図形を選択している場合は選択している図形の面積の合計値を出したいです)

また、このプログラムを自作アドインとして、他の図面上でも実行できるようにしたいです。

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

このようにしたところ実行時エラーになってしまいます。

Sub test()
    MsgBox ActiveWindow.Selection.AreaIU * 2.54 ^ 2
End Sub

補足

こちら（ http://www.interq.or.jp/chubu/r6/visio/DVS_18_Drawing_with_Automation840.htm ）で触れられている selection を使うことも試みましたが、

Sub test2()
    Dim selectObj
       
    Set selectObj = ActiveWindow.Selection
    If selectObj.Count = 0 Then
        MsgBox "先に図形を選択してください。", , "図形を選択してください"
    Else
        MsgBox selectObj.Shapes(1).AreaIU * 2.54 ^ 2
    End If
    
End Sub

というコードだと、エラーになります。Selection の中にある　Shape を指定する方法が分からず、詰まっています。

Comments

[TakaiY]

ちょっと検索してみただけで以下のページがヒットしますが、ここにでてくるSelectionを使うのはだめな理由がありますか？

https://learn.microsoft.com/ja-jp/office/vba/api/visio.selection

同時にこんなページもヒットします
http://www.interq.or.jp/chubu/r6/visio/DVS_18_Drawing_with_Automation840.htm

[koridentetsu]

Sub test2()
Dim selectObj

Set selectObj = ActiveWindow.Selection
If selectObj.Count = 0 Then
MsgBox "先に図形を選択してください。", , "図形を選択してください"
Else
MsgBox selectObj.Shapes(1).AreaIU * 2.54 ^ 2
End If

End Sub

というコードだと、エラーになってしまいます…。
Selection の中にある　Shapeを指定する方法が分からず、詰まっています。

[TakaiY]

ということであれば、質問にそのことを追記したほうが、よりよい回答を得やすいと思いますよ。
質問は編集できますので。

[koridentetsu]

ありがとうございます。追加させていただきました。

Answer 1

Selection の中にある　Shapeを指定する方法

Claude AI 先生に聞いてみました。選択した図形については For Each を使うと良いようです。

Sub 選択図形の合計面積の表示()
    Dim shp As Visio.Shape
    Dim S As Double
    
    ' 選択されている図形がない場合のエラー処理
    If ActiveWindow.Selection.Count = 0 Then
        MsgBox "図形が選択されていません。", vbExclamation
        Exit Sub
    End If
    
    S = 0
    
    ' 選択された各図形に対して処理を実行
    For Each shp In ActiveWindow.Selection
        S = S + shp.AreaIU * 2.54 ^ 2 '平方インチをcm^2に換算
    Next
    
    MsgBox Round(S, 5) & "(cm^2)"
End Sub

Comments

[koridentetsu]

ありがとうございます！
やりたかったことが実現できました。