【テクニカル・上級編】単一シェイプを複数レイヤーに重複所属させる：Shape.LayerおよびLayerCountプロパティの高度なレイヤー管理 – Visio VBA解析バイブル

単一シェイプを複数レイヤーに重複所属させる：Shape.LayerおよびLayerCountプロパティの高度なレイヤー管理

Visioのオブジェクトモデルを真に理解している開発者と、単なるマクロ記録の延長でコードを書いているプログラマーを分かつ決定的な境界線が存在する。その一つが、「レイヤー（Layer）」の概念と実装に対する理解の深さである。

多くのグラフィックツール（CADやIllustratorなど）において、レイヤーは「階層構造（木構造）」であり、1つのオブジェクトは原則としてただ1つの親レイヤーに属する。しかし、Visioのアーキテクチャは根本的に異なる。Visioにおけるレイヤーとは「タグ（多対多のN:M関係）」である。 単一のシェイプ（`Shape` オブジェクト）は、同時に複数のレイヤーに所属することができ、それぞれのレイヤーの可視性（Visible）や印刷性（Print）の論理積（あるいは論理和）によって描画が制御される。

本稿では、電気配線図と機械配置図の双方にまたがる設備機器など、実務で頻出する「複数レイヤー重複所属」の制御ロジックについて、VBA/COMインターフェースの深層仕様、パフォーマンス最適化、そしてレガシーコード保守に耐えうる堅牢な実装手法を解説する。

—

1. Visioレイヤーモデルの深層アーキテクチャ

Visioにおけるレイヤーの実態を理解するには、まず `Layer` オブジェクトと `Shape` オブジェクトの「非対称な関係」を理解しなければならない。

`Shape.LayerCount` と `Shape.Layer(Index)` の真実

`Shape` オブジェクトには、自身が属するレイヤーの数を返す `LayerCount` プロパティと、属しているレイヤーオブジェクトを取得する `Layer` プロパティが存在する。

‘ 概念的なアクセス（読み取り専用）
Dim i As Integer
For i = 1 To oShape.LayerCount
Debug.Print oShape.Layer(i).Name
Next i

ここで極めて重要なのは、`Shape.Layer` プロパティは「読み取り専用（ReadOnly）」であるという点だ。
つまり、以下のようなコードはコンパイルエラー、あるいは実行時エラーとなる。

‘ 【誤り】これは動作しない
Set oShape.Layer(1) = oPage.Layers(“NewLayer”)

レイヤー操作の非対称性：制御は常に `Layer` オブジェクトから行う

シェイプを特定のレイヤーに所属させる、あるいは脱退させるという操作は、`Shape` 側からではなく、`Layer` オブジェクトのメソッドを介して行う必要がある。

• 追加: `Layer.Add(SheetObject, fPreserveMembers)`
• 削除: `Layer.Remove(SheetObject, fPreserveMembers)`

この設計思想（非対称性）こそが、Visio VBAにおけるレイヤー操作のすべての起点となる。

—

2. 破滅を避けるための最重要パラメータ：`PreserveMembers`

`Layer.Add` および `Layer.Remove` メソッドの第2引数である `fPreserveMembers`（整数型 / `Integer`）は、重複所属を制御する上での生命線であり、誤用すると図面データを破壊する「レガシーの罠」が隠されている。

`Layer.Add` における挙動

oLayer.Add oShape, fPreserveMembers

| `fPreserveMembers` の値 | 挙動 |
| :— | :— |
| `0` (False) | 排他的追加。対象シェイプが現在所属している他のすべてのレイヤーから離脱させ、このレイヤーにのみ所属させる。 |
| `1` (True) | 重複追加（タグ追加）。既存のレイヤー所属状態を完全に維持したまま、新たなレイヤーをマッピングする。 |

単一シェイプを複数レイヤーに重複所属させる場合は、必ず `1` (True) を指定しなければならない。

`Layer.Remove` における「図形消滅」の罠

oLayer.Remove oShape, fPreserveMembers

このメソッドの挙動は、さらに慎重に扱う必要がある。

| `fPreserveMembers` の値 | 挙動 |
| :— | :— |
| `0` (False) | 破壊的削除。対象シェイプが他にどのレイヤーに属していようとも、図面（Page）からシェイプそのものを物理的に削除（Delete）する。 |
| `1` (True) | 論理的離脱。対象レイヤーの所属から外すだけで、シェイプ自体は存続させる。他のレイヤーに所属している場合はそこに残り、どのレイヤーにも属さなくなった場合は「レイヤーなし」のシェイプとしてページ上に存続する。 |

多くの開発者が、単に「レイヤーから外す」つもりで `fPreserveMembers = 0` を指定し、本番環境の図面からシェイプを物理的に消失させるという致命的なバグを埋め込んできた。安全な論理的離脱を行うには、常に `1` (True) を指定しなければならない。

—

3. 極限のVBA実装：動的重複マッピングクラス

数千個のシェイプが存在する大規模図面において、トランザクション（Undo/Redoバッファ）やCOMオブジェクトの解放、描画エンジンの制御を無視したコードは、即座にメモリリークとパフォーマンスの崩壊を招く。

以下に、エンタープライズ環境での稼働に耐えうる、エラーハンドリングとパフォーマンス最適化を極限まで高めた堅牢な実装を示す。

標準モジュール：`ModLayerController`

Option Explicit

‘ ==============================================================================
‘ 業務自動化エンジン – レイヤー動的マッピングモジュール
‘ ==============================================================================

”’

Public Sub AssignShapeToLayers(ByRef targetShape As Visio.Shape, _
ByRef layerNames() As String, _
Optional ByVal clearExisting As Boolean = False)

If targetShape Is Nothing Then Exit Sub

Dim vsoApp As Visio.Application
Set vsoApp = targetShape.Application

‘ パフォーマンス最適化の開始
On Error GoTo ErrorHandler
TogglePerformanceMode vsoApp, True

‘ トランザクション（Undo Scope）の開始
Dim undoScopeID As Long
undoScopeID = vsoApp.BeginUndoScope(“Assign Shape to Multiple Layers”)

Dim targetPage As Visio.Page
Set targetPage = targetShape.ContainingPage

Dim layersColl As Visio.Layers
Set layersColl = targetPage.Layers

‘ 1. 既存レイヤーのクリア処理（要求された場合）
If clearExisting Then
ClearAllLayersFromShape targetShape
End If

‘ 2. 指定されたレイヤー群へのマッピング
Dim i As Long
For i = LBound(layerNames) To UBound(layerNames)
Dim currentLayerName As String
currentLayerName = Trim$(layerNames(i))

If Len(currentLayerName) > 0 Then
Dim oLayer As Visio.Layer
Set oLayer = GetOrCreateLayer(layersColl, currentLayerName)

‘ 重複所属を維持するため、PreserveMembers には 1 (True) を指定
oLayer.Add targetShape, 1

‘ メモリ解放
Set oLayer = Nothing
End If
Next i

‘ トランザクションのコミット
vsoApp.EndUndoScope undoScopeID, True

CleanExit:
‘ パフォーマンス最適化の解除
TogglePerformanceMode vsoApp, False

‘ COM参照の明示的解放
Set layersColl = Nothing
Set targetPage = Nothing
Set vsoApp = Nothing
Exit Sub

ErrorHandler:
Dim errDesc As String, errNum As Long
errDesc = Err.Description
errNum = Err.Number

‘ ロールバックを試みる
If undoScopeID <> 0 Then
vsoApp.EndUndoScope undoScopeID, False
End If

TogglePerformanceMode vsoApp, False
Err.Raise errNum, “AssignShapeToLayers”, “レイヤーマッピング処理中にエラーが発生しました: ” & errDesc
End Sub

”’

Public Sub ClearAllLayersFromShape(ByRef targetShape As Visio.Shape)
If targetShape Is Nothing Then Exit Sub

Dim i As Long
‘ Shape.LayerCount は動的に減少するため、ループは常に末尾（インデックス1）から逆順で行う
For i = targetShape.LayerCount To 1 Step -1
Dim oLayer As Visio.Layer
Set oLayer = targetShape.Layer(i)

‘ PreserveMembers に 1 (True) を指定し、物理削除を防ぐ
oLayer.Remove targetShape, 1

Set oLayer = Nothing
Next i
End Sub

”’

Private Function GetOrCreateLayer(ByRef layersColl As Visio.Layers, ByVal layerName As String) As Visio.Layer
On Error Resume Next
Dim targetLayer As Visio.Layer
Set targetLayer = layersColl.Item(layerName)
On Error GoTo 0

If targetLayer Is Nothing Then
Set targetLayer = layersColl.Add(layerName)
End If

Set GetOrCreateLayer = targetLayer
End Function

”’

Private Sub TogglePerformanceMode(ByRef vsoApp As Visio.Application, ByVal enableOptimization As Boolean)
With vsoApp
If enableOptimization Then
.ScreenUpdating = 0
.DeferRecalc = 1
.EventsEnabled = 0
Else
.ScreenUpdating = 1
.DeferRecalc = 0
.EventsEnabled = 1
End If
End With
End Sub

呼び出し側のコード例

Sub ExecLayerDynamicAssignment()
Dim targetShape As Visio.Shape
Set targetShape = Visio.ActivePage.Shapes.ItemFromID(1) ‘ 対象のシェイプID

‘ 所属させたい複数レイヤーの定義
Dim targetLayers(2) As String
targetLayers(0) = “01_電気配線系統”
targetLayers(1) = “02_機械レイアウト”
targetLayers(2) = “99_共通管理オブジェクト”

‘ 既存のレイヤー所属をクリアした上で、上記3つのレイヤーに重複所属させる
AssignShapeToLayers targetShape, targetLayers, ClearExisting:=True

‘ 所属確認ログ出力
Debug.Print “— 所属レイヤー一覧 —”
Dim i As Integer
For i = 1 To targetShape.LayerCount
Debug.Print “Index: ” & i & ” -> ” & targetShape.Layer(i).Name
Next i
End Sub

—

4. レガシー環境保守における「ShapeSheet」の罠と解決策

VBAのオブジェクトモデル（API）レベルでレイヤーを制御していても、Visioの心臓部である ShapeSheet（シェイプシート） の動作仕様を理解していないと、意図しない描画バグ（先祖返りなど）に苦しむことになる。

レイヤー色の優先度（Layer Color Precedence）

シェイプを複数レイヤーに所属させた際、各レイヤーで異なる「色（Color）」や「線種（LineStyle）」が設定されている場合、どの設定が適用されるのだろうか？

この挙動は、ShapeSheetの `LayerMembership` セル、および各レイヤー自体のプロパティによって決定される。

1. カラーオーバーライドのルール:
Visioのレイヤー設定において「色を強制（Color precedence）」が有効になっているレイヤーに属している場合、Shape自体の色設定（`FillForegnd` など）よりも、レイヤーの色が最優先される。
2. 競合時の優先順位:
複数の所属レイヤーで「色を強制」が有効になっている場合、`Shape.LayerCount` において最もインデックスが若い（最初に追加された）レイヤーの設定が優先される。

動的に所属レイヤーを切り替えるシステムを構築する場合、この優先順位をコントロールするために、一時的に他レイヤーから論理離脱させる、あるいはShapeSheet内の `Geometry` セクションのセル値を直接VBAから書き換えて「親レイヤーによる強制（`THEME` または `MSOTG` 関数など）」をオーバーライドする設計が必要となる。

‘ ShapeSheetのセル値を書き換え、レイヤーの色強制をバイパスして個別の色を維持する例
oShape.CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaForce = “RGB(255,0,0)”

—

5. 設計思想：COM参照の徹底的解放とガベージコレクション

Visio VBAは、背後で重厚なCOM（Component Object Model）アーキテクチャが動作している。特にループ処理の中で `Layer` や `Shape` を大量に生成・取得する場合、オブジェクト変数（参照カウンタ）のハンドリングを怠ると、プロセスのメモリ空間が断片化し、最終的に「アウト・オブ・メモリ（メモリ不足）」で異常終了する。

1. `Set Object = Nothing` の徹底:
プロシージャを抜ける際、またはループの各イテレーションの最後で、必ず明示的にオブジェクト変数に `Nothing` を代入する。
2. `ContainingPage` や `Application` への参照ショートカットを避ける:
`oShape.ContainingPage.Layers.Item(…)` のような「ドットを重ねたチェーン記述」は、暗黙的な一時COMオブジェクトをメモリ上に残し、ガベージコレクション（GC）の対象外となるリスクを高める。必ず変数に1段階ずつ代入して管理すること。

‘ 【推奨される段階的代入】
Dim oPage As Visio.Page
Set oPage = oShape.ContainingPage

Dim oLayers As Visio.Layers
Set oLayers = oPage.Layers

‘ … 処理 …

‘ 【解放】
Set oLayers = Nothing
Set oPage = Nothing

結言

Visioにおける複数レイヤーへの重複所属制御は、複雑なプラント設計や系統図、ITインフラのネットワークマップなどを動的にレンダリングするシステムにおける「極めて強力な武器」である。

本稿で解説した `Layer.Add/Remove` の非対称性、`PreserveMembers = 1` による図面消失破壊の回避、そしてトランザクションとCOM解放を徹底したアーキテクチャ設計を順守すれば、レガシーとモダンが融合したエンタープライズVBA開発において、他の追随を許さない圧倒的に堅牢なシステムを構築可能となる。