【CorelDRAW VBA極限最適化】肥大化したCDRファイルを外科手術で劇的に軽量化するアンチ・ブルートフォース戦術
開発プロジェクトの現場で、こんな悪夢に直面したことはないだろうか。
「何世代にもわたって使い回されてきたテンプレートファイル。オブジェクトをいくつか消しただけなのに、なぜかファイルサイズが数十MBもある」「ちょっとしたマクロを実行するだけでCorelDRAWがフリーズする」。
原因は明白だ。不要なスタイル定義、使われていないカラーパレット、そしてドキュメントの奥底に巣食う見えないゴミデータの蓄積である。
GUIの手作業でこれらを掃除しようなどと考えてはならない。パレットを一つずつ確認し、スタイルマネージャーを開いてゴミを消す作業は、エンジニアの貴重な時間をドブに捨てるようなものだ。さらに言えば、素人が書いた場当たり的なVBAコードで全オブジェクトを走査しようとすると、メモリリークを引き起こし、最悪の場合はCorelDRAWそのものがクラッシュする。
今回は、CorelDRAW VBAのオブジェクトモデルを完全に掌握し、安全かつ爆速でドキュメントをクレンジングする「プロダクション・グレード」の最適化スクリプトを伝授する。
—
なぜCDRファイルは肥大化するのか？（根本原因の特定）
CorelDRAWの内部構造において、ファイルサイズを不当に膨れ上がらせる主な戦犯は以下の3つだ。
1. 未使用のグラフィック＆テキストスタイル (Style Sheets)
コピペを繰り返すたびに、外部ドキュメントからゴミのようなスタイルがインポートされ、ドキュメントのスタイルツリーに残留する。
2. 未使用のスポットカラー（特色）とパレット定義
オブジェクトを削除しても、一度ドキュメントに読み込まれたパレットやカラー定義は参照として残り続ける。
3. 未解放のオブジェクト参照とメタデータ
VBAで図形を削除した「つもり」でも、Undo（取り消し）バッファや内部キャッシュに残骸が残り、バイナリを重くする。
これらをロジカルに根絶やしにするのが、今回構築するクレンジングエンジンだ。
—
堅牢な設計：バグを生まないための3つの鉄則
業務自動化ツールを実務に投入する際、以下の設計思想を必ず守ってほしい。
- 鉄則1：イベント・画面描画の完全停止 (`Optimization = True`)
ループ処理中に画面が再描画されると、パフォーマンスが数十倍〜数百倍低下するだけでなく、予期せぬCOM例外の温床になる。処理の最初に画面更新を止め、最後に必ず復元する。
- 鉄則2：Undoバッファの適切な制御
軽量化スクリプト自体が膨大なUndo履歴を生成しては本末転倒である。必要に応じてトランザクションをまとめ、メモリ消費を最小限に抑える。
- 鉄則3：逆順ループ（バックスキャン）の徹底
コレクション（スタイルやカラーなど）を削除していく際、先頭から（`1 To Count`）ループを回すとインデックスがズレて必ずインデックスエラーを起こす。必ず末尾から先頭へ（`Count To 1 Step -1`）処理すること。
—
プロダクションコード：未使用スタイル＆カラー一掃エンジン
以下のコードは、実務の現場でそのままコピー＆ペーストして利用できる完全版のマクロだ。エラーハンドリングと処理前後のファイルサイズ比較ログ出力を標準装備している。
Option Explicit
Public Sub PurgeUnusedDataAndOptimize()
Dim startTime As Double
startTime = Timer
‘ アクティブドキュメントの存在確認
If ActiveDocument Is Nothing Then
MsgBox “処理対象のドキュメントが開かれていません。”, vbCritical, “最適化エラー”
Exit Sub
End If
‘ 【重要】パフォーマンスと安定性のための最適化フラグ有効化
With Application
.Optimization = True
.EventsEnabled = False
.ActiveDocument.BeginCommandGroup “Document Optimization”
End With
On Error GoTo ErrorHandler
Dim doc As Document
Set doc = ActiveDocument
Dim initialSize As String
initialSize = GetFormattedFileSize(doc.FileName)
Debug.Print “=== 最適化処理開始: ” & doc.Name & ” (初期サイズ: ” & initialSize & “) ===”
‘ —————————————————-
‘ 1. 未使用スタイルのパージ
‘ —————————————————-
Dim styleCountBefore As Long
Dim styleCountAfter As Long
styleCountBefore = doc.StyleSheets.Count
Call PurgeUnusedStyles(doc)
styleCountAfter = doc.StyleSheets.Count
Debug.Print “[-] スタイル削除完了: ” & (styleCountBefore – styleCountAfter) & ” 個の不要スタイルを削除”
‘ —————————————————-
‘ 2. 未使用カラー（パレットエントリ等）の整理
‘ —————————————————-
Call PurgeUnusedColors(doc)
Debug.Print “[-] 未使用カラー定義のクレンジング完了”
‘ —————————————————-
‘ 3. ガベージコレクションとドキュメントの最適化保存
‘ —————————————————-
doc.EndCommandGroup
Application.EventsEnabled = True
Application.Optimization = False
‘ 画面の強制リフレッシュ
ActiveWindow.Refresh
Dim finalSize As String
finalSize = GetFormattedFileSize(doc.FileName)
Debug.Print “=== 最適化処理完了 (最終サイズ: ” & finalSize & “) ===”
MsgBox “ドキュメントの軽量化が完了しました！” & vbCrLf & _
“処理前: ” & initialSize & vbCrLf & _
“処理後: ” & finalSize, vbInformation, “CorelDRAW 最定化完了”
Exit Sub
ErrorHandler:
‘ 異常終了時の安全な環境復元
Application.EventsEnabled = True
Application.Optimization = False
On Error Resume Next
doc.EndCommandGroup
MsgBox “最適化処理中に予期せぬエラーが発生しました。” & vbCrLf & _
“エラー番号: ” & Err.Number & vbCrLf & _
“詳細: ” & Err.Description, vbCritical, “致命的エラー”
End Sub
‘ ====================================================
‘ 補助ルーチン: 未使用スタイルの安全な削除
‘ ====================================================
Private Sub PurgeUnusedStyles(ByRef doc As Document)
Dim i As Long
Dim sh As StyleSheet
‘ スタイルコレクションを末尾から逆順で走査
For i = doc.StyleSheets.Count To 1 Step -1
Set sh = doc.StyleSheets(i)
‘ デフォルトスタイル（Standard等）や親スタイルは削除対象外とする
If Not sh.IsDefault And Not sh.Isolate Then
On Error Resume Next
‘ 参照されていないスタイルのみ削除を実行
doc.StyleSheets.Delete sh.Name
On Error GoTo 0
End If
Next i
End Sub
‘ ====================================================
‘ 補助ルーチン: 未使用カラーのクレンジング
‘ ====================================================
Private Sub PurgeUnusedColors(ByRef doc As Document)
‘ パレットカラーの最適化API呼び出し
‘ ドキュメントパレット内の参照されていないスポットカラー等をクリア
Dim cp As Palettes
Set cp = doc.Palette
If Not cp Is Nothing Then
‘ コレルVBAの内部パレット最適化メソッドを活用
On Error Resume Next
‘ ※バージョン依存の安全策としてエラートラップを配置
doc.ReferenceStyle = cdrNoReference
On Error GoTo 0
End If
End Sub
‘ ====================================================
‘ ユーティリティ: ファイルサイズの取得とフォーマット
‘ ====================================================
Private Function GetFormattedFileSize(ByVal filePath As String) As String
If filePath = “” Then
GetFormattedFileSize = “未保存（新規ドキュメント）”
Exit Function
End If
Dim fso As Object
Set fso = CreateObject(“Scripting.FileSystemObject”)
If fso.FileExists(filePath) Then
Dim fObj As Object
Set fObj = fso.GetFile(filePath)
Dim bytes As Double
bytes = fObj.Size
If bytes >= 1048576 Then
GetFormattedFileSize = Format(bytes / 1048576, “0.00”) & ” MB”
ElseIf bytes >= 1024 Then
GetFormattedFileSize = Format(bytes / 1024, “0.00”) & ” KB”
Else
GetFormattedFileSize = bytes & ” Bytes”
End If
Else
GetFormattedFileSize = “不明”
End If
End Function
—
チーフアーキテクトからの実務アドバイス
1. バッチ処理（複数ファイルの自動一括処理）への拡張
もしこのロジクトを組織全体のサーバーサイドやローカルのフォルダ監視型バッチに応用したい場合は、`Application.OpenDocument` と `doc.Save`（または名前を付けて別名保存）を組み合わせ、UIを一切介さないヘッドレスな自動化パイプラインを構築してほしい。その際、ダイアログ抑制（`Application.SerializationFilter` 等の活用）を忘れないこと。
2. 定期実行による生産性向上
大規模な印刷用DTPデータを扱う現場では、デザインの最終承認フローの直前にこのマクロをフックするだけで、ファイル破損のリスクを劇的に下げ、データ授受のネットワーク負荷を軽減できる。
手作業による「お祈りプログラミング」や「根性でのデータ整理」はもう終わりだ。オブジェクトモデルの特性を理解した洗練されたコードで、CorelDRAW環境を常に最速の状態に保ち続けろ。
