図面上に配置されている図形をリストアップ


Visioドキュメントに配置したたくさんの図形の中から、ある条件に合うものをだけを抽出してリストアップしたり、グループごとに集計するマクロです。

リスト上で選択したものをズームインしたり、まとめて数量や図形データを更新したりできるようにしました。

Visio上に配置されている図形をリストアップしたり、リスト上で選択したもののデータを一括変更したり、種類ごとに集計してExcel出力したりするマクロです。クラスを作るなりもっと効率のいいコーディングがあるはずですが、とりあえず、こんなことができますよというご紹介です。

下記はリストアップのコードから抜粋したものです。

For Each vsoShape In ActivePage.Shapes

(中略)

If vsoShape.CellExists("Prop.ItemName", 0) Then itemName = vsoShape.CellsU("Prop.ItemName.Value").FormulaU If InStr(1, itemName, """""") > 0 Then itemNameArray(cnt) = Mid(Replace(itemName, """""", ""), 2, 200) Else itemNameArray(cnt) = Replace(itemName, """", "") End If End If

Next

図形データのフィールドを一個一個配列にいれてるんです。阿保ですね。(どなたか、多次元配列を要素数を増やしながら使う技を教えてください)

しかも部材の名前にインチを意味する”(ダブルクオーテーション)が入りまくってるので一筋縄ではいきません。

条件検索に柔軟に対応するため、そこからさらにADODBのレコードセットに配列のデータを入れて、フィルターをかける始末。

Set rs = New ADODB.Recordset rs.Fields.Append "ID", adDouble rs.Fields.Append "ItemName", 200, 100  (中略) rs.Fields.Append "Left", adDouble rs.CursorLocation = adUseClient rs.Open Dim i As Long Dim e As Long On Error Resume Next For i = 0 To UBound(routeNameArray) rs.addNew rs.Fields("ID") = idArray(i) rs.Fields("ItemName") = itemNameArray(i) rs.Fields("ItemNameQT") = itemNameQTArray(i) rs.Fields("SortOrder") = itemSortOrderArr

 (中略)

 rs.Filter = strFilter rs.Sort = skey rs.Update

最後に、ユーザーフォームのリストビューにデータを登録していくという流れです。

グループ集計の場合はさらにややこしい。

Visio VBAに関しては、海外を含めても参考になるサイトが非常に少ないですね。私くらいのレベルでもVisio VBAを扱った情報が発信できれば、世間様に少しはお役に立てるのかもしれません。

#VisioVBA #マクロ #Visio