CorelDRAW VBAを掌握する極限の知見
【印刷事故 0件へ】全ビットマップ解像度一括スキャン・ログ化エンジンの全貌
シニアアーキテクトの領域へようこそ。
印刷業界および大規模DTPの現場において、「低解像度画像の看過によるピンボケ印刷」は、企業の信頼を一瞬で失墜させる致命的なインシデントである。手作業による目視確認や、プロパティを一つずつ開くような前時代的なアプローチは、エンジニアリングの敗北を意味する。
今回は、CorelDRAWドキュメント内に点在するすべてのビットマップオブジェクトを再帰的に走破し、その実効解像度（DPI）をミリ秒単位で算出してログ化、さらに規定値未満のデータを即座に検知・警告する実用マクロの全貌を公開する。
レガシーなVBAランタイムの制約をねじ伏せ、メモリリークを完全に封じ込めるための「極限の知見」をここに記す。
—
1. アーキテクチャの設計思想と技術的課題
CorelDRAW VBAにおける最大の罠は、「オブジェクトモデルの抽象化レイヤーの重み」と「COMラッパーのメモリ管理の曖昧さ」にある。
特に、グループ化（`Layer` / `ShapeRange` / `Group`）された階層構造の内部に潜むビットマップを網羅的にスキャンする場合、単純な `ActivePage.Shapes` のループでは、ネストされたグループ内の画像を取りこぼすか、型ミスマッチエラーを引き起こす。
本エンジンでは、以下の要件をクリアする設計を採用している。
1. 再帰的走帰（Recursive Traversal）による完全網羅
グループやブレンド、コンテナの内部に隠蔽されたビットマップであっても、例外なく捕捉する。
2. 実効解像度（Effective DPI）の正確な算出
画像本来のピクセル数に対し、レイアウト上でどれだけ拡大・縮小（スケーリング）されているかを加味した「真の解像度」を算出する。
3. 明示的なオブジェクト解放とメモリ最適化
VBAのガベージコレクションに依存せず、`Shape` や `Bitmap` オブジェクトの参照をループごとに完全に破棄し、巨大なDTPデータ処理時におけるメモリ肥大化（Bloat）を防ぐ。
—
2. 実装コード：一括スキャン＆ロギングエンジン
以下のコードをCorelDRAWのVBAエディタ（Visual Basic for Applications）の標準モジュールに貼り付けて実行せよ。実務の現場で直ちに稼働するプロダクション品質のコードである。
Option Explicit
‘ ==============================================================================
‘ 印刷事故防止：ビットマップ解像度一括スキャン・警告エンジン
‘ Architecture Chief Architect tuned for CorelDRAW VBA
‘ ==============================================================================
‘ 定数定義
Const THRESHOLD_DPI As Double = 300# ‘ 許容する最低解像度（DPI）
Public Sub ScanBitmapResolution()
Dim doc As Document
Set doc = ActiveDocument
If doc Is Nothing Then
MsgBox “アクティブなドキュメントが存在しません。”, vbCritical, “致命的エラー”
Exit Sub
Pi
‘ 処理時間計測用
Dim startTime As Double
startTime = Timer
‘ ログ用バッファ（大量の文字列結合による断片化を防ぐため配列またはシンプル出力）
Dim logText As String
logText = “— CorelDRAW Bitmap Resolution Audit Log —” & vbCrLf & _
“Target Document: ” & doc.Name & vbCrLf & _
“Threshold DPI: ” & THRESHOLD_DPI & vbCrLf & _
“———————————————-” & vbCrLf
Dim lowResCount As Long
lowResCount = 0
Dim totalScanned As Long
totalScanned = 0
‘ エラーハンドリングの有効化
On Error GoTo ErrorHandler
‘ ページの走査開始
Dim sh As Shape
Dim pageIndex As Long
For pageIndex = 1 To doc.Pages.Count
doc.Pages(pageIndex).Activate
For Each sh In doc.ActivePage.Shapes
Call TraverseShapes(sh, logText, lowResCount, totalScanned)
Next sh
Next pageIndex
‘ 処理結果の集計
logText = logText & “———————————————-” & vbCrLf & _
“Total Scanned Bitmaps: ” & totalScanned & vbCrLf & _
“Low Resolution Warning: ” & lowResCount & ” items.” & vbCrLf & _
“Execution Time: ” & Format(Timer – startTime, “0.00”) & ” seconds.”
‘ ログの出力（イミディエイトウインドウ ＋ テキストファイル出力等への拡張可能）
Debug.Print logText
‘ 結果通知
If lowResCount > 0 Then
MsgBox “スキャン完了: 規定値（” & THRESHOLD_DPI & ” DPI）を下回る画像が ” & lowResCount & ” 件検出されました。” & vbCrLf & _
“詳細はイミディエイトウインドウを確認してください。”, vbExclamation, “品質警告”
Else
MsgBox “スキャン完了: すべてのビットマップが基準解像度を満たしています。”, vbInformation, “品質正常”
End
Exit Sub
ErrorHandler:
MsgBox “予期せぬエラーが発生しました: ” & Err.Description, vbCritical, “システムエラー”
End Sub
‘ ==============================================================================
‘ 再帰的シェイプ走査プロシージャ
‘ ==============================================================================
Private Sub TraverseShapes(ByRef sh As Shape, ByRef log As String, ByRef warningCount As Long, ByRef totalCount As Long)
If sh Is Nothing Then Exit Sub
‘ グループやコンテナの場合は内部を再帰的に掘り下げる
If sh.Type = cdrGroupShape Then
Dim subSh As Shape
For Each subSh in sh.Shapes
Call TraverseShapes(subSh, log, warningCount, totalCount)
Next subSh
Exit Sub
End If
‘ オブジェクトがビットマップであるかを厳密に判定
If sh.Type = cdrBitmapShape Then
totalCount = totalCount + 1
Dim bmp As cdrBitmap
Set bmp = sh.Bitmap
‘ 実効解像度（Effective DPI）の取得
‘ CorelDRAWのAPIでは、スケーリングを考慮した解像度プロパティが存在する
Dim effDpiX As Double, effDpiY As Double
effDpiX = bmp.ResolutionX
effDpiY = bmp.ResolutionY
‘ 最小値を代表値とする
Dim currentDpi As Double
currentDpi = IIf(effDpiX < effDpiY, effDpiX, effDpiY)
' ログへの記録文字列生成
Dim pageNum As Long
pageNum = sh.Layer.Page.Index
log = log & "[Page " & pageNum & "] Shape ID: " & sh.StaticID & _
" | Size: " & Format(sh.SizeWidth, "0.0") & "x" & Format(sh.SizeHeight, "0.0") & "mm" & _
" | Resolution: " & Format(currentDpi, "0.0") & " DPI"
' 閾値判定
If currentDpi < THRESHOLD_DPI Then
log = log & " ==> [WARNING: LOW RESOLUTION]” & vbCrLf
warningCount = warningCount + 1
Else
log = log & ” [OK]” & vbCrLf
End If
‘ 厳格なオブジェクト参照の解放（メモリ最適化）
Set bmp = Nothing
End If
‘ 参照の明示的破棄
Set sh = Nothing
End Sub
—
3. チーフアーキテクトが解説する「コードの急所」
① `cdrGroupShape` に対する再帰アルゴリズム
DTPデータにおいて、画像が単独でルート層に存在することは稀である。多くは「表紙デザイン」「レイアウト枠」「チラシのパーツ群」などのグループ内にネストされている。
このコードでは、`sh.Type = cdrGroupShape` を検知した場合、自身のプロシージャを再帰呼び出し（`TraverseShapes`）することで、何重にネストされたグループであっても一切の漏れなくビットマップを抽出する。
② 実効解像度（Effective DPI）のトラッキング
初心者が犯す最大のミスは、ビットマップの「元データが持つ解像度」だけで判定してしまうことである。
例えば、元画像が300dpiであっても、レイアウト上で300%に拡大されていれば、実効解像度は100dpiに低下し、印刷物としては粗いモザイク状になってしまう。
CorelDRAWの `Bitmap.ResolutionX / ResolutionY` プロパティは、現在のオブジェクトサイズ（変形・スケール後）にアジャストされた実効値を返すため、印刷事故を防ぐための判定基準として極めて正確である。
③ メモリリークの完全封鎖（`Set xxx = Nothing`）
VBAにおけるCOMオブジェクトの扱いはデリケートだ。特にドキュメント内の数千に及ぶシェイプオブジェクトをループ処理する際、参照を解放し忘れるとVBAランタイムのヒープ領域が圧迫され、CorelDRAW自体の強制終了（クラッシュ）を誘発する。
ループの最後、およびプロシージャの抜け際において `Set sh = Nothing` や `Set bmp = Nothing` を明示的に実行し、ガベージコレクションの確実な動作を促す設計としている。
—
4. さらなる高みへ：システム間連携とCI/CD的運用
このVBAマクロを単なる「手動実行ツール」で終わらせるな。
シニアエンジニアであれば、これを社内の生産管理システムや、印刷入稿前の自動プリフライト（Preflight）パイプラインの一部として組み込むべきだ。
- 外部自動化（COM Automation）:
VB.NETやC#でヘッドレス（GUIなし）のCorelDRAWインスタンスを起動し、このVBAロジックを外部から呼び出すことで、デザインサーバー上で「入稿データの夜間自動チェックシステム」を構築可能である。
- JSON/CSV出力への拡張:
上記の `logText` 文字列をファイルシステム（`Scripting.FileSystemObject`）経由でCSV出力し、Webダッシュボードに非同期送信すれば、「どのデザイナーのどのファイルに低解像度画像が含まれていたか」を組織全体で一元管理できる。
技術は常に現場のトラブルを解決するためにある。このエンジンをあなたの開発環境に組み込み、印刷事故の恐怖から解放された堅牢なワークフローを構築せよ。
