CorelDRAW VBA爆速化の極意：`ActiveSelectionRange`を活用したループレスな属性一括置換アーキテクチャ
CorelDRAWのVBA開発において、100点あるいは1,000点を超えるオブジェクトのカラーや線幅を一括変更する際、処理の完了まで数秒から数十秒のフリーズが発生した経験はないでしょうか。
もしあなたが `For Each shp In ActiveSelection.Shapes` のようなループを回して1シェイプずつ `shp.Fill.ApplyUniformFill` や `shp.Outline.Width` を実行しているなら、アーキテクチャの根本的な設計ミスです。
本稿では、COMオブジェクト呼び出しのオーバーヘッドを極限まで削減し、CorelDRAWの内部C++エンジンに処理を委譲する`ActiveSelectionRange`を活用した非反復処理（ループレス）一括置換テクニックを解説します。現場のプロダクション環境でそのまま運用できる、例外処理とパフォーマンス最適化を完璧に施したコードを提示します。
—
1. なぜ `For Each` ループは遅く、失敗するのか？
CorelDRAW VBAの裏側では、VBA（COMクライアント）とCorelDRAW本体（C++で書かれたCOMサーバー）の間で巨大なアパートメント境界（COM Marshaling）を跨ぐプロセス間通信が行われています。
従来のループ処理が抱える3大ボトルネック
[VBA領域] —-(COM呼び出し)—-> [CorelDRAW C++エンジン]
│ │
├── 1. 各要素へのアクセス ───────────┼─> COM境界のオーバーヘッド(N回)
├── 2. 個別の属性変更 ──────────────┼─> UI描画ツリーの更新(N回)
└── 3. Undo履歴の生成 ───────────────┼─> 履歴スタックの圧迫(N個のコマンド)
1. COM境界跨ぎのオーバーヘッド ($N$回発生)
ループを1回回すたびに、VBAからCorelDRAW APIへのプロパティ取得・設定リクエストが発生します。1,000個のオブジェクトがあれば、2,000回以上の通信が発生します。
2. UI再描画とグラフィックキャッシュの破棄
明示的に画面更新を停止しない限り、オブジェクト1つの色が変化するたびにCorelDRAWはドキュメントツリーの再描画と境界ボックス（Bounding Box）の再計算を試みます。
3. Undoスタックの肥大化とメモリ圧迫
1要素ごとに1つの「元に戻す」コマンドが生成されると、ユーザーのUndo履歴が破壊されるだけでなく、メモリ消費量が跳ね上がります。
結論として、「VBA側でループを回す」こと自体が、高負荷処理におけるアンチパターンなのです。
—
2. 解決策：`ShapeRange` オブジェクトへの一括委譲
CorelDRAWのAPIには、複数のシェイプを単一のコレクションとして扱い、C++ネイティブ層で一括操作するための `ShapeRange` オブジェクトが用意されています。
`ActiveSelectionRange` は、現在選択されているオブジェクト群を単一の `ShapeRange` として返します。この `ShapeRange` に対して属性変更メソッドを1度だけ呼び出すことで、処理速度は数十分の一から数百分の一に短縮されます。
| 比較項目 | `For Each` ループ方式 | `ActiveSelectionRange` 一括方式 |
| :— | :— | :— |
| 処理方式 | 反復処理（VBA側で制御） | 一括処理（CorelDRAWエンジンへ委譲） |
| COM通信回数 | $O(N)$（要素数に比例） | $O(1)$（定数時間） |
| Undoスタック | 要素数分のコマンド | 1つのアトミックなトランザクション |
| 処理速度(1000要素) | 数秒〜数十秒 | 一瞬間（数ミリ秒） |
—
3. プロダクション環境対応：完全実装コード
実務でそのまま使える堅牢なマクロコードです。
以下の要件を完璧に満たしています：
- ループ無しの高速プロパティ適用 (`ApplyUniformFill`, `SetOutlineProperties`)
- 描画停止・イベント停止による極限の高速化 (`Optimization.Begin`)
- アトミックなUndoグループ化 (`BeginCommandGroup`)
- 安全なエラー処理とリソースの確実な解放 (`On Error GoTo` によるクリーンアップ保障)
Attribute VB_Name = “modBatchPropertyReplacer”
Option Explicit
” ==============================================================================
” 処理名称：ActiveSelectionRangeを活用した高速属性一括置換
” 目的 ：選択された複数のシェイプに対し、ループ処理を行わず一括で
” 塗りつぶしカラーおよび輪郭線（太さ・カラー）を変更する。
” 開発者 ：チーフ・アーキテクト
” ==============================================================================
Public Sub BatchApplyPropertiesToSelection()
‘ ドキュメントが開かれているか確認
If ActiveDocument Is Nothing Then
MsgBox “ドキュメントが開かれていません。”, vbExclamation, “エラー”
Exit Sub
End If
‘ 1. 現在の選択範囲をShapeRangeとして取得
Dim targetRange As ShapeRange
Set targetRange = ActiveSelectionRange
‘ ガードクローズ：何も選択されていない場合は即時脱出
If targetRange.Count = 0 Then
MsgBox “プロパティを変更するオブジェクトを選択してください。”, vbInformation, “対象なし”
Exit Sub
End If
‘ — パフォーマンス最適化およびトランザクション制御の開始 —
On Error GoTo ErrorHandler
‘ A. 画面更新およびイベントの同期を停止
Application.Optimization.Begin
Application.EventsEnabled = False
‘ B. Undo履歴を1つのグループに統合（アトミック操作化）
ActiveDocument.BeginCommandGroup “Batch Property Replacement”
‘ ————————————————————————–
‘ 2. 核心部：ShapeRangeに対する一括プロパティ適用（ループレス）
‘ ————————————————————————–
‘ 【塗りつぶし変更】プロセスカラー（CMYK: シアン100%, マゼンタ50%, イエロー0%, ブラック0%）を適用
Dim newFillColor As Color
Set newFillColor = CreateCMYKColor(100, 50, 0, 0)
targetRange.ApplyUniformFill newFillColor
‘ 【輪郭線変更】太さを0.5mm、カラーをK100%に一括設定
‘ ※ SetOutlineProperties はスタイル、端点、結合方式なども一括指定可能
Dim newOutlineColor As Color
Set newOutlineColor = CreateCMYKColor(0, 0, 0, 100)
targetRange.SetOutlineProperties _
LineWidth:=0.5, _
Color:=newOutlineColor, _
BehindFill:=cdrFalse, _
ScaleWithShape:=cdrTrue
‘ ————————————————————————–
CleanUp:
‘ — リソース解放と状態の復元（正常系・異常系共通） —
‘ Undoグループの終了
ActiveDocument.EndCommandGroup
‘ イベントおよび画面更新の再開
Application.EventsEnabled = True
Application.Optimization.End
‘ 画面の即時再描画
Application.Refresh
Exit Sub
ErrorHandler:
‘ エラーハンドリング
MsgBox “プロパティ一括変更中に例外が発生しました。” & vbCrLf & _
“エラー詳細: ” & Err.Description & ” (Code: ” & Err.Number & “)”, _
vbCritical, “システムエラー”
‘ 強制的にクリーンアップ処理へジャンプ
Resume CleanUp
End Sub
—
4. 堅牢なマクロ構築のための深掘り解説
上記のコードには、現場でバグを起こさないための設計思想が組み込まれています。
① `Application.Optimization.Begin` の本質
`Application.Optimization.Begin` は、CorelDRAWに「これから連続して内部データを変更するが、命令が完了するまでキャンバスを再描画するな」と命じるフラグです。これを怠ると、たとえ `ShapeRange` を使っていても内部的な再描画イベントが走り、パフォーマンスが著しく低下します。
② Undoの整合性を保つ `BeginCommandGroup`
`BeginCommandGroup` を呼ぶことで、マクロが行った一連の属性変更がユーザー視点では「1回の `Ctrl + Z`」で元に戻せるようになります。
不具合発生時に `EndCommandGroup` が呼ばれずに終了すると、CorelDRAWのUndoスタックが破損するリスクがあるため、必ず `On Error GoTo ErrorHandler` を仕込み、`CleanUp:` セクション経由で確実に `EndCommandGroup` を通る構造にしています。
③ カラーモデル（CMYK / RGB）の明示的定義
印刷業務向け自動化ツールにおいて、単に `cdrColorRed` などの定数や暗黙の型変換を使うのは危険です。
本コードのように `CreateCMYKColor()` や `CreateRGBColor()` を用いてカラーモデルを明示的にインスタンス化して渡すことで、CorelDRAWのカラーマネジメント設定に依存した意図しない色変換事故を防ぐことができます。
—
5. 応用と発展：外部データ連携（CSV / データベース）への拡張
実務では、「外部の仕様書（CSVやDB）に基づいて、特定の条件を満たす図形の属性を一括変更する」という案件が多発します。
その場合も、「条件判定だけをVBAで行い、該当するオブジェクトをひとつの `ShapeRange` に追加し、最後に一括適用する」というアーキテクチャを採用してください。
条件合致オブジェクトを一括処理するパターン
‘ 判定条件に合うオブジェクトを集約する空の ShapeRange を作成
Dim targetCollection As New ShapeRange
Dim shp As Shape
‘ ドキュメント全体から条件に合うシェイプを検索してコレクションに追加
For Each shp In ActiveDocument.ActivePage.Shapes
If shp.Type = cdrRectangleShape Then ‘ 例: 矩形オブジェクトのみ抽出
targetCollection.Add shp
End If
Next shp
‘ 集約したShapeRangeに対して「ループレス」で一括適用
If targetCollection.Count > 0 Then
targetCollection.ApplyUniformFill CreateCMYKColor(0, 0, 0, 20)
targetCollection.SetOutlineProperties LineWidth:=1.0
End If
このアプローチであれば、ループ内では「参照の追加（`targetCollection.Add`）」しか行われないため、COM重密度の高い属性操作をループ内で行うより圧倒的に高速に動作します。
—
まとめ：最高峰のエンジニアが守るべき3原則
1. `ActiveSelectionRange` (または `ShapeRange`) を使い、一括処理メソッドをコールせよ。
2. `Optimization.Begin` と `BeginCommandGroup` を対で使い、描画とUndoを最適化せよ。
3. 例外発生時でも必ず `Optimization.End` に辿り着く構造（`Try-Finally` パターン）を徹底せよ。
コードの美しさは、そのまま実行速度と保守性に直結します。適切なオブジェクトモデルを選択し、CorelDRAWのポテンシャルを極限まで引き出す自動化ツールを構築してください。
