印刷入稿の絶対防壁！CorelDRAW VBAで極める「全テキスト・アウトライン化」と「フォント未埋め込み自動チェッカー」の構築
印刷入稿データ作成における最大のタブー、それが「フォントの未アウトライン化（文字化け・フォント置換）」です。
「入稿前に全選択して `Ctrl + Q`（カーブに変換）を押すだけ」――言葉にすれば簡単ですが、実務の現場はそんなに甘くありません。グループ化の階層深くに入れ子になったテキスト、PowerClip（クリッピングマスク）の内部に隠れたテキスト、あるいはロックされたレイヤー上のテキストなど、手動はおろか、単純なマクロでも容易にすり抜けてしまう「罠」が随所に潜んでいるからです。
本記事では、CorelDRAWのオブジェクトモデルを深く理解し、「変換漏れを絶対に許さない再帰的アウトライン化エンジン」と、処理後にフォントが残っていないかを厳密に検証する「二重チェック（ダブルチェック）システム」をVBAで構築します。
単に動くだけのコードではなく、実務の過酷なマルチページ・大容量データに耐えうる、堅牢で高速なプロダクションコードの設計思想を伝授しましょう。
—
1. なぜ、あなたのマクロは「変換漏れ」を起こすのか？
よくある「ネットで拾ったVBAコード」が実務で使い物にならない理由は、CorelDRAWのドキュメント構造（DOM）に対する認識の甘さにあります。まずは、私たちが破壊しなければならない「3つの壁」を理解してください。
罠①：昇順ループによる「インデックスのズレ」
テキストオブジェクトをループ処理でカーブ（Shape）に変換すると、そのオブジェクトはテキストではなくなり、コレクションのインデックスが動的に変化します。
‘ 【バグの温床】昇順ループ
For i = 1 To ActivePage.Shapes.Count
If ActivePage.Shapes(i).Type = cdrTextShape Then
ActivePage.Shapes(i).ConvertToCurves ‘ ここでインデックスがズレて、次のオブジェクトがスキップされる！
End If
Next i
要素数が変化するコレクションを操作する場合、「逆順（後退）ループ」で回すか、「対象オブジェクトの参照を一度別配列に退避させる」、あるいは「再帰処理で末端から処理する」のが鉄則です。
罠②：PowerClipとグループ化の「入れ子構造」
CorelDRAWのテキストは、グループ（`cdrGroupShape`）の中、さらにはPowerClipのコンテナの中に格納されていることが多々あります。単一レイヤーの `Shapes` コレクションをなぞるだけでは、これら「深階層」のテキストにアクセスできません。
完全な自動化には、オブジェクトのタイプを判定し、グループやPowerClipであればその内部をさらに探索する「再帰（Recursive）アルゴリズム」が不可欠です。
罠③：ロックされたオブジェクトと非表示レイヤー
ロックされたオブジェクト（`Shape.Locked = True`）や、ロックされたレイヤー上にあるテキストに対して `ConvertToCurves` を実行すると、CorelDRAWは容赦なく「実行時エラー（エラー 70: 書き込み禁止）」を吐いて強制終了します。
プロフェッショナルなコードには、「一時的にロックを解除し、処理後に元の状態へ復元する」というステート管理が求められます。
—
2. 堅牢なアーキテクチャ設計
今回構築するツールの処理フローは以下の通りです。ユーザーに「安心」を提供するため、単に処理するだけでなく、処理前後の状態チェックとレポート機能を統合します。
[処理開始]
│
├── ① 描画更新の停止 (Optimization = True) ＆ イベント停止
│
├── ② ロック状態の解析と一時解除（エラー回避の布石）
│
├── ③ 再帰エンジンによる全テキストのアウトライン化（PowerClip/グループ完全対応）
│
├── ④ 元のロック状態の完全復元
│
├── ⑤ 二重チェック（ドキュメント内にテキストが残存していないか走査）
│
├── ⑥ 描画更新の再開 (Optimization = False)
│
[処理終了 / 結果レポート表示]
—
3. 完全実装：プロダクション・グレードのVBAコード
以下のコードを、CorelDRAWのVBAエディタ（`Alt + F11`）の標準モジュールに貼り付けてください。実務での運用を想定し、エラーハンドリング、パフォーマンス最適化、詳細なログ出力を完備しています。
‘=============================================================================
‘ Module: Mod_OutlineEngine
‘ Description: 印刷入稿用・全テキストのアウトライン化および残存フォントチェッカー
‘ Author: CorelDRAW VBA Architect
‘=============================================================================
Option Explicit
‘ 処理統計用グローバル変数
Private m_ConvertedCount As Long
Private m_SkippedCount As Long
Private m_ErrorCount As Long
”’
”’
Public Sub ExecuteFullOutliner()
Dim doc As Document
Set doc = ActiveDocument
If doc Is Nothing Then
MsgBox “アクティブなドキュメントが開かれていません。”, vbCritical, “エラー”
Exit Sub
End If
‘ ユーザーへの最終確認
If MsgBox(“ドキュメント内の全テキストをカーブに変換します。” & vbCrLf & _
“※処理後に上書き保存しないようご注意ください（バックアップ推奨）。” & vbCrLf & _
“実行しますか？”, vbQuestion + vbYesNo, “実行確認”) <> vbYes Then
Exit Sub
End If
‘ パフォーマンス最適化の開始
On Error GoTo ErrorHandler
CorelDRAW.ActiveDocument.BeginCommandGroup “Full Outline and Check”
SetOptimization True
‘ 統計リセット
m_ConvertedCount = 0
m_SkippedCount = 0
m_ErrorCount = 0
Dim pg As Page
Dim lay As Layer
Dim sh As Shape
‘ ドキュメント内の全ページ・全レイヤーを走査
For Each pg In doc.Pages
pg.Activate
For Each lay In pg.Layers
‘ 編集不可能なレイヤー（ロックされている、または非表示）の一時的解除
Dim isLayerLocked As Boolean
Dim isLayerVisible As Boolean
isLayerLocked = lay.Locked
isLayerVisible = lay.Visible
If isLayerLocked Then lay.Locked = False
If Not isLayerVisible Then lay.Visible = True
‘ レイヤー内のオブジェクトを走査（後退ループでインデックスズレを防止）
Dim i As Long
For i = lay.Shapes.Count To 1 Step -1
Set sh = lay.Shapes(i)
ProcessShape sh
Next i
‘ レイヤー状態の復元
lay.Locked = isLayerLocked
lay.Visible = isLayerVisible
Next lay
Next pg
‘ 最適化の解除（これを行わないと画面が更新されません）
SetOptimization False
CorelDRAW.ActiveDocument.EndCommandGroup
‘ — 二重チェックフェーズ —
Dim remainingTextCount As Long
remainingTextCount = CheckForRemainingTexts(doc)
‘ 結果レポートの生成
Dim reportMsg As String
reportMsg = “【処理完了レポート】” & vbCrLf & vbCrLf & _
“・カーブ変換成功: ” & m_ConvertedCount & ” 件” & vbCrLf & _
“・スキップ（ロック等）: ” & m_SkippedCount & ” 件” & vbCrLf & _
“・エラー発生: ” & m_ErrorCount & ” 件” & vbCrLf & vbCrLf
If remainingTextCount = 0 Then
reportMsg = reportMsg & “【合格】ドキュメント内に未変換のテキストは検出されませんでした。安全に入稿可能です。”
MsgBox reportMsg, vbInformation, “チェック完了”
Else
reportMsg = reportMsg & “【警告】ドキュメント内に ” & remainingTextCount & ” 件のテキストが残存しています！” & vbCrLf & _
“非表示レイヤー、マスターページ、またはサポート外の特殊オブジェクト内を確認してください。”
MsgBox reportMsg, vbExclamation, “警告：テキスト残存”
End If
Exit Sub
ErrorHandler:
SetOptimization False
If Not doc Is Nothing Then CorelDRAW.ActiveDocument.EndCommandGroup
MsgBox “致命的なエラーが発生しました: ” & Err.Description, vbCritical, “システムエラー”
End Sub
”’
”’
Private Sub ProcessShape(ByVal sh As Shape)
On Error GoTo ShapeErrorHandler
‘ ロックされたオブジェクトの一時解除用フラグ
Dim isLocked As Boolean
isLocked = sh.Locked
‘ 1. テキストオブジェクトの場合
If sh.Type = cdrTextShape Then
If isLocked Then sh.Locked = False
‘ カーブに変換
sh.ConvertToCurves
m_ConvertedCount = m_ConvertedCount + 1
Exit Sub
End If
‘ 2. グループオブジェクトの場合（再帰探索）
If sh.Type = cdrGroupShape Then
If isLocked Then sh.Locked = False
Dim gSh As Shape
Dim j As Long
‘ グループ内を逆順で走査
For j = sh.Shapes.Count To 1 Step -1
ProcessShape sh.Shapes(j)
Next j
If isLocked Then sh.Locked = True
Exit Sub
End If
‘ 3. PowerClipオブジェクトの場合（再帰探索）
If Not sh.PowerClip Is Nothing Then
If isLocked Then sh.Locked = False
Dim pcSh As Shape
Dim k As Long
‘ PowerClipの内部オブジェクトを走査
For k = sh.PowerClip.Shapes.Count To 1 Step -1
ProcessShape sh.PowerClip.Shapes(k)
Next k
If isLocked Then sh.Locked = True
Exit Sub
End If
Exit Sub
ShapeErrorHandler:
m_ErrorCount = m_ErrorCount + 1
‘ 必要に応じてログファイルやイミディエイトウィンドウに出力
Debug.Print “Error processing Shape ID ” & sh.StaticID & “: ” & Err.Description
Resume Next
End Sub
”’
”’
Private Function CheckForRemainingTexts(ByVal doc As Document) As Long
Dim textCount As Long
textCount = 0
Dim pg As Page
Dim sh As Shape
‘ FindShapes APIを使用して、ドキュメント全体からテキストオブジェクトを高速抽出
For Each pg In doc.Pages
Dim foundShapes As Shapes
‘ cdrTextShape（テキスト）に合致する全図形を検索（グループ内も走査対象）
Set foundShapes = pg.Shapes.FindShapes(Type:=cdrTextShape)
textCount = textCount + foundShapes.Count
Next pg
CheckForRemainingTexts = textCount
End Function
”’
”’
Private Sub SetOptimization(ByVal enable As Boolean)
With Application
If enable Then
.Optimization = True
.EventsEnabled = False
.ActiveWindow.ActiveView.ToFrameWork.DisableRedraw
Else
.Optimization = False
.EventsEnabled = True
.ActiveWindow.ActiveView.ToFrameWork.EnableRedraw
.Refresh
End If
End With
End Sub
—
4. コードの極限解説：なぜこの設計なのか？
① `FindShapes` と「後退ループ再帰」の使い分け
コード中では、アウトライン化（破壊的処理）と残存チェック（読み取り処理）で異なるアプローチを採用しています。
- アウトライン化時：
`FindShapes` を使って一括で変換しようとすると、グループ内オブジェクトの変換時に親グループの構造が破壊され、VBAのオブジェクト参照が迷子（メモリアクセス違反）になります。これを防ぐため、あえて「再帰関数 `ProcessShape` による末端からの手動走査（デプス・ファースト探索）」を行い、安全に1つずつカーブに変換しています。
- チェック時：
一方で、事後チェックはオブジェクトを破壊しないため、CorelDRAW最速の検索APIである `Shapes.FindShapes(Type:=cdrTextShape)` を使用して、超高速にテキストの残存数をカウントしています。
② `Optimization` と `DisableRedraw` による圧倒的な高速化
CorelDRAW VBAで大量のオブジェクトを処理する場合、1オブジェクト処理するたびに画面描画（Redraw）が発生し、これがボトルネックとなります。
`SetOptimization(True)` 内の `ActiveWindow.ActiveView.ToFrameWork.DisableRedraw` は、CorelDRAWの内部レンダリングエンジンを完全にスリープさせます。これにより、処理速度は約10倍〜50倍に跳ね上がります。
③ 徹底したステート（状態）管理
プロユースのツールにおいて、マクロ実行後に「ロックしていたレイヤーが勝手に解除されていた」「非表示にしていた確認用レイヤーが表示されたままになった」という事態は許されません。
本コードは、レイヤーやオブジェクトの `Locked` 状態を一時退避し、処理が通過した直後に元の状態へ復元する「ステートガード」を徹底しています。
—
5. 実務運用の現場における注意点と拡張
ファイルシステム（外部システム）との連携
このマクロを「入稿フォルダ監視型の自動パブリッッシュシステム」に組み込む場合、変換成功後に別名で自動保存するロジックを追加すると良いでしょう。
‘ （拡張例）別名保存の自動化
Dim originalName As String
originalName = doc.FullName
‘ 拡張子を「_outlined.cdr」に変更して保存
Dim exportPath As String
exportPath = Replace(originalName, “.cdr”, “_outlined.cdr”, , , vbTextCompare)
Dim saveOptions As StructSaveAsOptions
Set saveOptions = CreateStructSaveAsOptions()
saveOptions.Version = cdrCurrentVersion ‘ 最新バージョンで保存
doc.SaveAs exportPath, saveOptions
注意：元ファイルに対して `doc.Save`（上書き保存）を絶対に実行しないように、出力ルーチンは完全に分離してください。アウトライン化されたデータは二度とテキスト編集に戻せません。
—
6. 終わりに：自動化エンジニアとしての矜持
DTP・印刷業界における「文字化け」は、時に数百万円規模の刷り直し事故に直結する致命的なトラブルです。それを防ぐのは、オペレーターの「注意深い目」ではなく、「例外を1％も許さない冷徹なコード」であるべきです。
今回紹介した再帰探索アルゴリズムと二重チェッカーは、CorelDRAW VBA開発における最高峰の堅牢性を備えています。このコードをベースに、自社の入稿前チェックリストを一つずつ自動化し、クリエイティブな時間を最大化するための強固なパイプラインを構築してください。
