CorelDRAW VBAを掌握する極限の知見
第4章：ブランドコンプライアンスの自動監査システム —— 不許可フォント・禁止カラーを駆使して一網打尽にするDOM走査の極意
チーフアーキテクトの私だ。これまで数多のレガシーシステムとCorelDRAWアドインの爆発的なメモリリークを鎮圧してきた。
DTPオペレーターの目視によるブランドガイドラインのチェックなど、近代的な自動化の文脈においては「悪質な冗長性」に他ならない。数千ページのドキュメント、あるいは外部から雑多に持ち込まれた入稿データに対し、人間がフォントパレットやカラースウォッチを目視で確認するなど、コストの無駄遣いでありヒューマンエラーの温床だ。
今回は、CorelDRAWのドキュメント構造（DOM）の深淵に潜り込み、社内規定に違反するフォントおよび禁止カラーを使用しているシェイプをミリ秒単位で特定し、即座に警告・ハイライトする監査マクロの全貌を公開する。
レガシーなVBA環境において、いかにしてメモリを溺れさせず、数万のオブジェクトを高速に走査するか。その実装の極意を授けよう。
—
1. CorelDRAW DOMにおける「隠れオブジェクト」とメモリの罠
CorelDRAW VBAでドキュメントを全走査する際、素人が陥る最大の罠が「レイヤー構造の再帰処理におけるメモリリーク」と「ShapeRangeの無秩序な生成」である。
`ActivePage.Shapes` コレクションを安易にループさせると、COMラッパーの参照カウンタが肥大化し、大規模なデータでは確実にCorelDRAWごとフリーズ（あるいはOut of Memory）する。
真のアーキテクトは、オブジェクトのライフサイクルを完全に制御し、不要になったCOMオブジェクトは即座に `Nothing` 代号によって解放する。
さらに、グループ化されたオブジェクト（`cdrGroupShape`）、コンテナ、ブレンド、PowerClipの内部にネストされた「幽霊のようなシェイプ群」を正確に再帰探索するアルゴリズムが不可欠となる。
—
2. ブランド監査エンジンの実装コード
以下のコードは、指定された「不許可フォント名」と「禁止カラー（CMYK / RGBの閾値）」を完全網羅し、違反しているシェイプの周囲に赤色の警告用ワイヤーフレーム（監査レイヤー）を動的生成してハイライトする、実戦投入仕様のモジュールである。
Option Explicit
‘ ==============================================================================
‘ CorelDRAW ブランドコンプライアンス自動監査エンジン
‘ Architecture Type: Recursive DOM Traversal with Memory Optimization
‘ ==============================================================================
‘ — 監査設定定数 —
Private Const FORBIDDEN_FONT_1 As String = “Impact” ‘ 禁止フォント例1
Private Const FORBIDDEN_FONT_2 As String = “Comic Sans MS” ‘ 禁止フォント例2
Private Const AUDIT_LAYER_NAME As String = “_AUDIT_VIOLATIONS”
Public Sub ExecuteBrandAudit()
Dim startTime As Double
startTime = Timer
‘ 画面描画とイベントを停止し、処理速度を極限まで引き上げる（パフォーマンス最適化）
EventsEnabled = False
CorelDRAW.Optimization = True
On Error GoTo ErrorHandler
‘ 1. 監査結果格納用レイヤーの初期化
Dim auditLayer As Layer
Set auditLayer = PrepareAuditLayer(ActivePage)
‘ 2. ドキュメント全体の再帰走査実行
Dim violationCount As Long
violationCount = 0
Dim shp As Shape
For Each shp In ActivePage.Shapes
ProcessShapeRecursive shp, auditLayer, violationCount
Next shp
‘ 3. 処理完了の通知
CorelDRAW.Optimization = False
EventsEnabled = True
MsgBox “ブランド監査が完了しました。” & vbCrLf & _
“検出された違反件数: ” & violationCount & ” 件” & vbCrLf & _
“処理時間: ” & Format(Timer – startTime, “0.00”) & ” 秒”, _
vbInformation, “CorelDRAW Compliance Engine”
Exit Sub
ErrorHandler:
CorelDRAW.Optimization = True
EventsEnabled = True
MsgBox “致命的なエラーが発生しました: ” & Err.Description, vbCritical
End Sub
‘ ==============================================================================
‘ 再帰的シェイプ走査プロシージャ（グループ・PowerClip対応）
‘ ==============================================================================
Private Sub ProcessShapeRecursive(ByVal shp As Shape, ByVal targetLayer As Layer, ByRef count As Long)
Dim isViolated As Boolean
isViolated = False
On Error GoTo CleanUp
‘ — A. テキストオブジェクトのフォント監査 —
If shp.Type = cdrTextShape Then
If shp.Text.Story.Font = FORBIDDEN_FONT_1 Or shp.Text.Story.Font = FORBIDDEN_FONT_2 Then
isViolated = True
End If
End If
‘ — B. シェイプのカラー（塗りつぶし）監査 —
‘ ※今回は例として特定の禁止カラー（例: 純粋なマゼンタ CMYK(0,100,0,0) 等）を検知
If shp.Fill.Type = cdrUniformFill Then
Dim c As Color
Set c = shp.Fill.UniformColor
‘ 例: CMYKモードでマゼンタが100%かつ他が0の場合を禁止カラーとする
If c.Array(0) = 0 And c.Array(1) = 100 And c.Array(2) = 0 And c.Array(3) = 0 Then
isViolated = True
End If
Set c = Nothing
End If
‘ — C. 違反検出時のハイライト処理 —
If isViolated Then
count = count + 1
HighlightViolation shp, targetLayer
End If
‘ — D. 複合オブジェクト（グループ等）の再帰処理 —
If shp.Type = cdrGroupShape Then
Dim subShp As Shape
For Each subShp In shp.Shapes
ProcessShapeRecursive subShp, targetLayer, count
‘ COMオブジェクトのループ内解放
Set subShp = Nothing
Next subShp
ElseIf shp.HasShapes Then
‘ PowerClipやブレンド等の内部コンポーネント対応
Dim innerShp As Shape
For Each innerShp In shp.Shapes
ProcessShapeRecursive innerShp, targetLayer, count
Set innerShp = Nothing
Next innerShp
End If
CleanUp:
Set shp = Nothing
End Sub
‘ ==============================================================================
‘ 違反シェイプの周辺に監査用ボーダーを生成する
‘ ==============================================================================
Private Sub HighlightViolation(ByVal targetShp As Shape, ByVal targetLayer As Layer)
Dim bBox As Shape
‘ 違反オブジェクトのバウンディングボックスを取得し、同位置に赤枠を作成
Set bBox = targetLayer.CreateRectangle2(targetShp.LeftX, targetShp.BottomY, targetShp.SizeWidth, targetShp.SizeHeight)
With bBox
.Fill.ApplyNoFill
.Outline.SetProperties Width:=1, Color:=CreateCMYKColor(0, 100, 100, 0) ‘ 鮮やかな赤で警告
.Name = “VIOLATION_MARKER”
End With
Set bBox = Nothing
End Sub
‘ ==============================================================================
‘ 監査用レイヤーの準備（既存があればクリア）
‘ ==============================================================================
Private Function PrepareAuditLayer(ByVal page As Page) As Layer
Dim lyr As Layer
On Error Resume Next
Set lyr = page.Layers(AUDIT_LAYER_NAME)
On Error GoTo 0
If lyr Is Nothing Then
Set lyr = page.CreateLayer(AUDIT_LAYER_NAME)
Else
lyr.Shapes.All.Delete
End If
Set PrepareAuditLayer = lyr
Set lyr = Nothing
End Sub
—
3. チーフアーキテクトによるコード解説と極意
1. `CorelDRAW.Optimization = True` の絶対性
CorelDRAW VBAにおいて、画面描画やUIイベントを抑制せずに数千個のシェイプを処理させると、描画エンジンのリフレッシュ処理が挟まり、実行速度が数十倍〜数百倍に低下する。これを防ぐために冒頭での最適化フラグの有効化は必須だ。
2. メモリの明示的解放 (`Set … = Nothing`)
VBAのガベージコレクションは遅延実行される傾向がある。特に `For Each` によるコレクション走査や再帰呼び出しにおいて、ローカル変数に割り当てられたCOMオブジェクトをループの末尾で確実に `Nothing` に明示解放しないと、CorelDRAWのヒープ領域が徐々に圧迫され、大規模ドキュメントの処理途中でメモリ不足エラーを引き起こす。
3. 監査レイヤーの独立管理
元データを破壊せず、かつ修正作業を円滑に進めるため、検出された違反箇所を別レイヤー（`_AUDIT_VIOLATIONS`）に独立させて赤枠（ワイヤーフレーム）でマッピングする設計にしている。これにより、オペレーターは該当レイヤーの表示・非表示を切り替えるだけで、どこを修正すべきかが一目瞭然となる。
—
総括
デザインの統制は、個人の職人芸やモラルに依存してはならない。それはシステムによって「強制的に担保されるべきインフラストラクチャ」の一部なのだ。
今回提供したアーキテクチャをベースに、社内のNASに眠るテンプレート群や、外部ベンダーからの納品データを夜間に一括バッチ処理するシステム（Windows Script Hostや外部.NETラッパーからの呼び出し）へと昇華させてほしい。
真の自動化エンジニアであれば、仕様の隙間を技術で完全に塞ぎ、無駄な手戻りをゼロに抑え込むことだ。健闘を祈る。
