Visio VBAを掌握する極限の知見:Shape.IsSelectedを使わないスマートな非破壊ハイライト
長年Visio VBAシステムやレガシーアーキテクチャの最前線に立ってきた者として、私は数多の現場で、Visioの描画制御がもたらす複雑性と、それに対する安易なアプローチが引き起こす惨状を目の当たりにしてきました。特に、ユーザーの現在の選択状態を尊重せず、コードが勝手にオブジェクトを選択・解除するような処理は、生産性の破壊に他なりません。
本稿では、`Shape.IsSelected` に頼ることなく、ユーザーの作業を中断させず、かつUndoスタックを汚染することなく、特定の条件を満たすシェイプを一時的にハイライトし、処理後に完全に元の状態へ復元する、極限の非破壊ハイライト手法について解説します。これは単なる色の変更を超え、Visioオブジェクトモデルの深淵とWindows APIによるOSレベルの描画制御を掌握する知見です。
導入:なぜ `Shape.IsSelected` を避けるべきなのか
Visio VBAにおけるシェイプのハイライト処理を考える際、多くの者が最初に思いつくのは `Shape.Select` や `Application.ActiveWindow.Selection.Add` といった、Visioの選択メカニズムを利用する手法でしょう。しかし、これは致命的な設計ミスに繋がる危険性を孕んでいます。
1. ユーザーの作業中断: ユーザーが複数のシェイプを選択して何らかの作業を行っている最中に、コードが別のシェイプを `Select` したり、既存の `Selection` を `Clear` して `Add` したりすれば、ユーザーの選択状態は失われ、作業は強制的に中断されます。これはユーザーエクスペリエンスを著しく損ないます。
2. Undoスタックの汚染: `Select` や `Deselect` といった操作も、VisioのUndoスタックに記録されます。不要な操作がスタックに積まれることで、ユーザーが本当に元に戻したい操作が遠のいたり、Undoのパフォーマンスが低下したりする可能性があります。
3. パフォーマンスの低下: 大量のシェイプに対して `Select` や `Deselect` を繰り返すことは、COMインターフェイスを介したUI操作であり、非常に高いオーバーヘッドを伴います。特にネットワーク越しや、多くのイベントハンドラが設定されている環境では顕著です。
我々が求めるのは、Visioの描画レイヤーを直接制御し、UIの状態(特にSelection)には一切干渉しない、真に非破壊的なハイライトメカニズムです。
Visioオブジェクトモデルの深淵:CellのFormulaUを掌握する
Visioのシェイプの属性、例えば塗りつぶしの色 (`FillForegnd`) は、単なるRGB値を持つプロパティではありません。その実体は `ShapeSheet` 内の `Cell` オブジェクトであり、多くの場合、数式 (`Formula`) によって定義されています。
例えば、背景色がページの色にリンクしているシェイプの場合、`FillForegnd` セルの `FormulaU` (ユニバーサルフォーミュラ) は `ThePage!PageColor` となっているかもしれません。もしあなたが安易に `Shape.Cells(“FillForegnd”).Result(“RGB”) = RGB(255, 0, 0)` のように直接色を設定すれば、この `FormulaU` は `RGB(255,0,0)` というリテラル値に上書きされ、元の数式による連動性は永久に失われてしまいます。これはVisioの強力な「数式による振る舞い定義」という概念を破壊する行為です。
真に非破壊的なハイライトを実現するためには、以下の原則を徹底する必要があります。
1. 元の状態の完全保存: シェイプの変更対象となる `Cell` (例: `FillForegnd`) の現在の `FormulaU` を正確に取得し、メモリ上に保存します。`Result` ではなく `FormulaU` である点が極めて重要です。これにより、元の数式による連動性も保持したまま復元が可能になります。
2. 一時的な変更: 保存した `FormulaU` を元に戻せることを前提に、一時的なハイライト色を `FormulaU` として設定します。
3. 確実な復元: 処理完了後、保存しておいた `FormulaU` を再度 `Cell` に設定し直します。
このアプローチにより、Visioの内部状態を最小限に汚染し、Undoスタックにも不要なエントリを残しません。
実装戦略:OSレベルの描画制御とメモリ最適化
非破壊ハイライトと点滅効果を実現するためには、VisioのCOMレイヤーだけでなく、OSレベルの描画キューを制御するWindows APIの知識が不可欠です。
1. Windows API宣言
VBAからWindows APIを呼び出すには `Declare PtrSafe` ステートメントが必要です。`PtrSafe` は64bit版Officeに対応するためのものであり、現代の環境では必須です。
‘—————————————————————————————————
‘ Windows APIの宣言
‘ PtrSafeは64bit環境対応のために必須
‘—————————————————————————————————
If VBA7 Then
‘ 64bit環境向け
Private Declare PtrSafe Function Sleep Lib “kernel32” (ByVal dwMilliseconds As Long) As Long
Private Declare PtrSafe Function RedrawWindow Lib “user32” ( _
ByVal hWnd As Long, _
lpRect As Any, _
ByVal hrgnUpdate As Long, _
ByVal flags As Long _
) As Long
Else
‘ 32bit環境向け (レガシー環境向け)
Private Declare Function Sleep Lib “kernel32” (ByVal dwMilliseconds As Long) As Long
Private Declare Function RedrawWindow Lib “user32” ( _
ByVal hWnd As Long, _
lpRect As Any, _
ByVal hrgnUpdate As Long, _
ByVal flags As Long _
) As Long
End If
‘ RedrawWindow APIのフラグ定義
Private Const RDW_INVALIDATE As Long = &H1 ‘ ウィンドウのクライアント領域を無効化し、WM_PAINTメッセージをキューに入れる
Private Const RDW_ERASE As Long = &H4 ‘ 無効な領域が背景色で消去されるように指定
Private Const RDW_UPDATENOW As Long = &H100 ‘ WM_PAINTメッセージを即座に処理し、描画を強制する
2. 描画抑制と強制更新
`Application.ScreenUpdating = False` はVisioのCOMオブジェクトレベルでの描画更新を抑制しますが、これはOSの描画キューに影響を与えません。点滅効果のように短時間で状態を切り替える場合、`Sleep` の前後で `RedrawWindow` を呼び出して、OSに描画を強制させることが極めて重要です。これにより、Visioが内部的に描画更新を「サボる」ことを防ぎ、確実に画面に反映させます。
3. メモリ管理とオブジェクトの解放
VisioオブジェクトモデルはCOMベースであり、参照カウントによってオブジェクトのライフサイクルが管理されます。VBAではガベージコレクションがないため、明示的なオブジェクトの解放 (`Set obj = Nothing`) が不可欠です。特にループ内で多数の `Shape` オブジェクトを扱う場合、参照を適切に解放しないとメモリリークやパフォーマンス低下の原因となります。
‘—————————————————————————————————
‘ グローバル変数またはモジュールレベル変数
‘—————————————————————————————————
Private Type HighlightInfo
ShapeID As Long ‘ シェイプのID
OriginalFillForegnd As String ‘ 元の塗りつぶし前景色のFormulaU
End Type
Private g_HighlightShapes As Collection ‘ ハイライト対象のシェイプ情報を保持するコレクション
‘—————————————————————————————————
‘ メイン処理:条件に合致するシェイプをハイライトし、点滅させる
‘—————————————————————————————————
Public Sub SmartNonDestructiveHighlight()
Dim vsoApp As Visio.Application
Dim vsoDoc As Visio.Document
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim highlightInfo As HighlightInfo
Dim hWnd As Long
Dim i As Long
‘ エラーハンドリングの開始
On Error GoTo ErrorHandler
Set vsoApp = Visio.Application
Set vsoDoc = vsoApp.ActiveDocument
Set vsoPage = vsoApp.ActivePage
‘ 既にハイライト処理が実行中の場合は中断
If Not g_HighlightShapes Is Nothing Then
Call RestoreOriginalColors ‘ 既存のハイライトを元に戻す
Set g_HighlightShapes = Nothing ‘ コレクションをクリア
End If
Set g_HighlightShapes = New Collection
‘ Visioの描画更新を一時的に停止
vsoApp.ScreenUpdating = False
‘ 対象ウィンドウのハンドルを取得(RedrawWindow API用)
hWnd = vsoApp.ActiveWindow.WindowHandle32
‘ ページ内の全てのシェイプを走査
For Each vsoShape In vsoPage.Shapes
‘ 条件チェック:例として、シェイプのテキストに “重要” が含まれる場合
If InStr(1, vsoShape.Text, “重要”, vbTextCompare) > 0 Then
‘ 元の塗りつぶし前景色のFormulaUを保存
With highlightInfo
.ShapeID = vsoShape.ID
‘ Cellが存在しない場合のハンドリングも考慮
On Error Resume Next
.OriginalFillForegnd = vsoShape.Cells(“FillForegnd”).FormulaU
If Err.Number <> 0 Then
‘ Cellが存在しない場合はデフォルト値を設定するか、処理をスキップ
.OriginalFillForegnd = “RGB(255,255,255)” ‘ 例: 白をデフォルトとする
Err.Clear
End If
On Error GoTo ErrorHandler ‘ エラーハンドラを再開
End With
‘ コレクションに情報を追加
g_HighlightShapes.Add highlightInfo, CStr(vsoShape.ID)
‘ 一時的なハイライト色を設定 (例: 赤)
vsoShape.Cells(“FillForegnd”).FormulaU = “RGB(255,0,0)”
End If
Next vsoShape
‘ 描画更新を再開し、変更を即座に反映
vsoApp.ScreenUpdating = True
Call RedrawWindow(hWnd, ByVal 0&, ByVal 0&, RDW_INVALIDATE Or RDW_UPDATENOW Or RDW_ERASE)
‘ 点滅効果 (3回点滅)
For i = 1 To 3
Sleep 200 ‘ 200ミリ秒待機 (ハイライト表示状態)
‘ ハイライトを一時的に解除 (元の色に戻す)
Call TemporarilyRemoveHighlight(True)
Call RedrawWindow(hWnd, ByVal 0&, ByVal 0&, RDW_INVALIDATE Or RDW_UPDATENOW Or RDW_ERASE)
Sleep 200 ‘ 200ミリ秒待機 (非ハイライト表示状態)
‘ ハイライトを再度適用
Call TemporarilyRemoveHighlight(False)
Call RedrawWindow(hWnd, ByVal 0&, ByVal 0&, RDW_INVALIDATE Or RDW_UPDATENOW Or RDW_ERASE)
Next i
Sleep 500 ‘ 最後にハイライト状態をしばらく表示
‘ 全てのハイライトを元の状態に戻す
Call RestoreOriginalColors
‘ コレクションを解放
Set g_HighlightShapes = Nothing
Exit_Sub:
‘ オブジェクトの明示的な解放
Set vsoShape = Nothing
Set vsoPage = Nothing
Set vsoDoc = Nothing
‘ ApplicationオブジェクトはVBAが終了するまで解放しない (外部プロセスから起動していない場合)
Exit Sub
ErrorHandler:
MsgBox “エラーが発生しました: ” & Err.Description, vbCritical
‘ エラー発生時も元の色に戻す試行
If Not g_HighlightShapes Is Nothing Then
Call RestoreOriginalColors
Set g_HighlightShapes = Nothing
End If
Resume Exit_Sub
End Sub
‘—————————————————————————————————
‘ ハイライトを一時的に解除/再適用するサブルーチン (点滅用)
‘—————————————————————————————————
Private Sub TemporarilyRemoveHighlight(ByVal bRemove As Boolean)
Dim vsoApp As Visio.Application
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim highlightInfo As HighlightInfo
If g_HighlightShapes Is Nothing Or g_HighlightShapes.Count = 0 Then Exit Sub
Set vsoApp = Visio.Application
Set vsoPage = vsoApp.ActivePage
vsoApp.ScreenUpdating = False
For Each highlightInfo In g_HighlightShapes
On Error Resume Next ‘ シェイプが削除されている可能性を考慮
Set vsoShape = vsoPage.Shapes.ItemFromID(highlightInfo.ShapeID)
If Not vsoShape Is Nothing Then
If bRemove Then
‘ 元の色に戻す (非ハイライト状態)
vsoShape.Cells(“FillForegnd”).FormulaU = highlightInfo.OriginalFillForegnd
Else
‘ ハイライト色に戻す (ハイライト状態)
vsoShape.Cells(“FillForegnd”).FormulaU = “RGB(255,0,0)” ‘ 例: 赤
End If
End If
Set vsoShape = Nothing ‘ ループ内でオブジェクトを解放
On Error GoTo 0 ‘ エラーハンドラをリセット
Next highlightInfo
vsoApp.ScreenUpdating = True
Set vsoPage = Nothing
Set vsoApp = Nothing
End Sub
‘—————————————————————————————————
‘ 全てのハイライトを元の色に戻すサブルーチン
‘—————————————————————————————————
Private Sub RestoreOriginalColors()
Dim vsoApp As Visio.Application
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim highlightInfo As HighlightInfo
If g_HighlightShapes Is Nothing Or g_HighlightShapes.Count = 0 Then Exit Sub
Set vsoApp = Visio.Application
Set vsoPage = vsoApp.ActivePage
vsoApp.ScreenUpdating = False
For Each highlightInfo In g_HighlightShapes
On Error Resume Next ‘ シェイプが削除されている可能性を考慮
Set vsoShape = vsoPage.Shapes.ItemFromID(highlightInfo.ShapeID)
If Not vsoShape Is Nothing Then
‘ 元のFormulaUを戻す
vsoShape.Cells(“FillForegnd”).FormulaU = highlightInfo.OriginalFillForegnd
End If
Set vsoShape = Nothing
On Error GoTo 0
Next highlightInfo
vsoApp.ScreenUpdating = True
‘ 描画を強制更新
Call RedrawWindow(vsoApp.ActiveWindow.WindowHandle32, ByVal 0&, ByVal 0&, RDW_INVALIDATE Or RDW_UPDATENOW Or RDW_ERASE)
‘ コレクションをクリア
Set g_HighlightShapes = Nothing
Set vsoPage = Nothing
Set vsoApp = Nothing
End Sub
コードの解説と追加の洞察:
- `g_HighlightShapes` コレクション: ハイライト対象のシェイプのIDと元の `FormulaU` を `Type` で構造化し、`Collection` オブジェクトに保存しています。これにより、ハイライト解除時にどのシェイプを、どのような元の状態に戻すべきかを正確に把握できます。`Shape.ID` をキーとして利用することで、高速なアクセスが可能です。
- `ItemFromID` の利用: `vsoPage.Shapes.ItemFromID(highlightInfo.ShapeID)` を使用することで、コレクションを直接ループするよりも効率的に目的のシェイプを取得できます。また、ハイライト処理中にユーザーがシェイプを削除する可能性も考慮し、`On Error Resume Next` でエラーをハンドリングしています。
- `Application.ScreenUpdating` の役割: これはあくまでVisioアプリケーションの描画更新イベントを抑制するものです。点滅効果のように素早い描画の切り替えが必要な場合は、`RedrawWindow` を使ってOSレベルで描画を強制することが不可欠です。
- `Sleep` と `DoEvents` の違い: `Sleep` は現在のスレッドをブロックし、指定された時間だけ実行を停止します。UIスレッドがブロックされるため、アプリケーションは一時的に応答しなくなりますが、これによって点滅の「瞬間」を確実に制御できます。`DoEvents` はメッセージキューを処理するため、他のイベント(ユーザー操作など)が割り込む可能性があり、点滅のタイミングが不確実になるため、ここでは不適格です。
- `Cells(“FillForegnd”).FormulaU`: ここで `Result` ではなく `FormulaU` を使うことが、冒頭で述べた「数式による連動性の維持」の真髄です。例えば、元のシェイプがVisioのテーマ色 (`ThePage!ThemeColor`) を参照していた場合、`FormulaU` を保存することで、ハイライト解除後もそのテーマ色への参照が復活します。`Result` を保存すると、単なるRGB値として固定されてしまいます。
- エラーハンドリング: 堅牢なシステムには不可欠です。予期せぬエラーが発生した場合でも、可能な限り元の状態に復元を試みるべきです。
レガシー環境の保守とシステム間連携の極限の知見
この手法はVisio VBAの範疇に留まらず、より広範なレガシーシステムやシステム間連携の文脈でも応用可能な知見を含んでいます。
1. レガシー環境への配慮
- `PtrSafe`: 前述の通り、これは64bit版Officeの互換性のためです。古い32bit版Office環境(Visio 2003/2007/2010 32bitなど)で動作させる場合は、`#If VBA7 Then … #Else … #End If` ディレクティブで `PtrSafe` を含まない `Declare` ステートメントを定義する必要があります。本コードではその対応を行っています。
- COM参照の安定性: 古いVisioバージョンでは、COMオブジェクトの参照が不安定になるケースが稀にありました。`Set obj = Nothing` の徹底と、必要に応じて `GetObject(, “Visio.Application”)` と `CreateObject(“Visio.Application”)` を使い分ける判断が必要です。外部プロセスからVisioを操作する場合、必ず `CreateObject` で新しいインスタンスを生成するか、既に実行中のインスタンスを正確に `GetObject` で取得し、使用後は `Application.Quit` でプロセスを終了させるべきです。VBA内部からの操作であれば、通常 `Visio.Application` は実行中のインスタンスを指します。
2. システム間連携における描画制御
外部システム(例えば、.NETアプリケーションや別のOfficeアプリケーション)からVisioを自動制御する際、この非破壊ハイライトの原則はさらに重要になります。
- COMマーシャリングのオーバーヘッド: プロセス外COMオブジェクトへのアクセスは、プロセス内COMに比べてマーシャリング(データ変換)のコストがはるかに高くなります。`Application.ScreenUpdating = False` と `RedrawWindow` を組み合わせることで、不要な描画イベントを抑制し、COM呼び出しの回数を最小限に抑えることが、ネットワーク越しやリモートデスクトップ環境でのパフォーマンス向上に直結します。
- `HRESULT` エラーコードの理解: VBAでは `On Error GoTo` で抽象化されますが、COMエラーの根源は `HRESULT` コードです。外部システムとの連携では、Visioが返す `HRESULT` を直接デバッグする場面も出てきます。VisioのドキュメントやSDKには、特定の操作で発生しうる `HRESULT` の情報が含まれています。
- 同期と非同期: `Sleep` APIは同期的にスレッドをブロックしますが、外部システムとの連携では、非同期処理を検討する必要がある場面もあります。例えば、Visioでのハイライト表示中に、外部システムで別の処理を継続させたい場合などです。この場合、Visio VBA側でイベントハンドラを公開し、外部システムがそれをフックするようなアーキテクチャが求められますが、これは本稿の範囲を超えます。
まとめ
Visio VBAにおける非破壊ハイライトは、単なる機能実装ではなく、Visioのオブジェクトモデル、COMの挙動、そしてOSレベルの描画メカニズムに対する深い理解を要求します。`Shape.IsSelected` のような安易な選択ベースの操作を避け、`Cells(“FillForegnd”).FormulaU` を介してシェイプの真の姿を操作し、Windows API (`Sleep`, `RedrawWindow`) で描画を掌握する。そして、厳格なメモリ管理とエラーハンドリングを徹底すること。
これこそが、ユーザーの生産性を阻害せず、システムを堅牢に保ち、レガシー環境の寿命を延ばし、そしてシステム間連携の複雑性を乗り越えるための「極限の知見」です。現代のOffice Add-insやJavaScript APIの世界が広がる中でも、Visio VBAが提供するこのレベルの低レイヤー制御の価値は、今後も永続するでしょう。
