図面上に配置されている図形をリストアップ
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を扱った情報が発信できれば、世間様に少しはお役に立てるのかもしれません。
