【実務・中級編】【初心者向け】CorelDRAWドキュメント内に残された空のテキストフレームやゴミオブジェクトを自動検出して一括削除するクリーンアップツール – CorelDRAW VBA解析バイブル

スポンサーリンク

CorelDRAWを極める:意図せぬゴミオブジェクトを駆逐する「ドキュメント・クリーンアップツール」の設計思想

デザインの現場において、データ納品直前のトラブルほど胃が痛くなるものはない。
「文字化けを起こしている」「印刷に不要なパスが重なっている」「意図せぬ空のテキストフレームが残っていて、面付けの段階で予期せぬ版ズレを起こした」——これらはすべて、CorelDRAWのキャンバスの裏側に巣食う「ゴミオブジェクト」が原因だ。

手動でこれらをクレンジングしようものなら、レイヤーのロックを外し、一つひとつズームイン・アウトを繰り返して選択・削除……気が遠くなるような時間とヒューマンエラーのリスクを伴う。

今回は、CorelDRAW VBAのオブジェクトモデルの挙動を完全に掌握し、「一瞬で無駄を刈り取り、入稿データを極限まで軽量化する堅牢なクリーンアップマクロ」の設計と実装を伝授する。

—

なぜ素朴なループ処理は事故を起こすのか?(VBAの罠)

多くの初心者が最初に書くコードは、大抵このようなものだ:

‘ 【アンチパターン】絶対にやってはいけないループ
Dim s As Shape
For Each s In ActivePage.Shapes
If s.Type = cdrTextShape And s.Text.Story.Length = 0 Then
s.Delete
End If
Next s

プログラミング経験者なら直感的に気づくだろう。「コレクションの要素をループしながら、その要素をその場で削除(破壊)している」ため、インデックスのズレが生じ、必ず取りこぼしや実行時エラーが発生する。

さらにCorelDRAWのドキュメント構造は複雑だ。

  • 通常のレイヤー上にあるオブジェクト
  • グループ化(Group)された内部に眠る空フレーム
  • レイヤーを跨いだマスターページ上の要素

これらを網羅しつつ、メモリリークや処理落ちを防ぐプロフェッショナルな設計アプローチを解説しよう。

—

堅牢なクリーンアップツールのアーキテクチャ

プロダクション環境で耐えうるツールにするため、以下の要件を満たすコードを設計する。

1. 安全な逆順ループ(または再帰的走査):削除によるインデックスの崩壊を防ぐ。
2. グループ階層の再帰探索:グループ化された奥深くにあるゴミも見逃さない。
3. 詳細な判定ロジック:

  • 空のテキストフレーム(文字数が0、またはスペースや改行のみ)
  • 完全に塗りも線もない不可視のパス(ヘアラインのゴミなど)

4. トランザクション管理:`Optimization = True` による描画停止で爆速化。

—

コピペ即実戦投入可能なプロダクションコード

以下のコードをCorelDRAWのVBAエディタ(Alt + F11)の標準モジュールに貼り付けて実行してほしい。

Option Explicit

‘ ==============================================================================
‘ 業務自動化スイート: ドキュメント・クリーンアップツール
‘ 概要: アクティブページ内の空テキストフレーム及び無効なゴミパスを自動検出・一括削除
‘ ==============================================================================
Sub RunDocumentCleanup()
Dim startTime As Double
startTime = Timer

‘ 1. 描画・イベントを停止し、処理速度を限界まで引き上げる
EventsEnabled = False
ActiveDocument.BeginCommandGroup “ドキュメントクリーンアップ”

On Error GoTo ErrorHandler

Dim deletedTextCount As Long
Dim deletedPathCount As Long
deletedTextCount = 0
deletedPathCount = 0

‘ アクティブページの全シェイプ(グループ内含む)を再帰的に走査
ProcessShapesRecursive ActivePage.Shapes, deletedTextCount, deletedPathCount

‘ 2. 処理終了のコミット
ActiveDocument.EndCommandGroup
EventsEnabled = True

‘ 完了レポート
MsgBox “クリーンアップが完了しました。” & vbCrLf & _
“・削除された空テキストフレーム: ” & deletedTextCount & ” 件” & vbCrLf & _
“・削除された無効なパス: ” & deletedPathCount & ” 件” & vbCrLf & _
“処理時間: ” & Format(Timer – startTime, “0.00”) & ” 秒”, _
vbInformation, “CorelDRAW 自動クリーンアップ”
Exit Sub

ErrorHandler:
‘ 異常終了時のフォールバック
EventsEnabled = True
ActiveDocument.EndCommandGroup
MsgBox “エラーが発生しました: ” & Err.Description, vbCritical, “致命的なエラー”
End Sub

‘ ==============================================================================
‘ 再帰的シェイプ走査エンジン(グループ・レイヤーの壁を突破する)
‘ ==============================================================================
Private Sub ProcessShapesRecursive(ByVal shps As Shapes, ByRef textCount As Long, ByRef pathCount As Long)
Dim i As Long
‘ コレクションの破壊を防ぐため、必ず「後ろから前へ(逆順)」ループする
For i = shps.Count To 1 Step -1
Dim s As Shape
Set s = shps(i)

‘ オブジェクトがロックされている、または非表示の場合はスキップ
If Not s.Locked And Not s.Printable = False Then

‘ A. グループ化されている場合は内部を再帰的に探索
If s.Type = cdrGroupShape Then
ProcessShapesRecursive s.Shapes, textCount, pathCount

‘ グループの内部を掃除した結果、空っぽになったグループ自体も削除対象とする
If s.Shapes.Count = 0 Then
s.Delete
pathCount = pathCount + 1
End If

‘ B. テキストフレームの判定
ElseIf s.Type = cdrTextShape Then
If IsEmptyText(s) Then
s.Delete
textCount = textCount + 1
End If

‘ C. パス・形状オブジェクトの判定(塗りなし・線なし・極小パスの排除)
ElseIf s.Type = cdrCurveShape Or s.Type = cdrRectangleShape Or s.Type = cdrEllipseShape Then
If IsUselessPath(s) Then
s.Delete
pathCount = pathCount + 1
End If
End If

End If
Next i
End Sub

‘ ==============================================================================
‘ テキストが実質的に「空」であるかを判定するロジック
‘ ==============================================================================
Private Function IsEmptyText(ByVal s As Shape) As Boolean
IsEmptyText = False

On Error Resume Next
Dim txtContent As String
txtContent = s.Text.Story.Text

If Err.Number <> 0 Then
‘ テキストストーリーにアクセスできない場合は安全のためスルー
Exit Function
End If
On Error GoTo 0

‘ 改行やスペース、タブを除去して文字数が0なら「空」とみなす
Dim cleanedText As String
cleanedText = Trim(Replace(Replace(Replace(txtContent, vbCr, “”), vbLf, “”), vbTab, “”))

If Len(cleanedText) = 0 Then
IsEmptyText = True
End If
End Function

‘ ==============================================================================
‘ 無効なパス(描画されていない、あるいはゴミとみなすべきパス)の判定
‘ ==============================================================================
Private Function IsUselessPath(ByVal s As Shape) As Boolean
IsUselessPath = False

‘ 塗りつぶしがなく、かつ、アウトライン(線)もないオブジェクトは完全なゴミ
Dim hasFill As Boolean
Dim hasOutline As Boolean

hasFill = (s.Fill.Type <> cdrNoFill)
hasOutline = (s.Outline.Type <> cdrNoOutline)

If Not hasFill And Not hasOutline Then
IsUselessPath = True
Exit Function
End If

‘ ※必要に応じて、面積が極小のパス(バウンディングボックスが数ミリ以下など)を
‘ 弾くロジックをここに拡張可能です。
End Function

—

チーフアーキテクトからの実務アドバイス

1. `EventsEnabled = False` の重要性
CorelDRAWはオブジェクトが1つ削除されるたびに、UIの再描画やプレビューの更新を走らせようとする。これが数千個のオブジェクトがあるデータでフリーズやメモリリークを引き起こす主原因だ。描画を完全にサイレント化することで、処理速度が何倍にも跳ね上がる。
2. グループの「抜け殻」対策
ネストされたグループを掃除する際、中身が空になった親グループ(抜け殻)がそのまま残ると、次回の編集時にデザイナーを混乱させる。上記コードでは、`s.Shapes.Count = 0` を検知して親グループごと消し去るスマートな実装にしている。
3. 拡張性について
このコードをベースに、特定のレイヤー名(例: `”Guide”` や `”CutLine”`)を持つレイヤーを保護する条件分岐を追加すれば、印刷用テンプレートに特化した鉄壁のバリデーションツールへと進化させられる。

現場の品質は、こうした細部の自動化と徹底したクレンジングの積み重ねによって担保される。ぜひ今日のワークフローに組み込み、無駄な修正作業から解放されてほしい。

タイトルとURLをコピーしました