空のシートを一括で削除するマクロ｜CATIAマクロの作成方法
今回は「お問い合わせ」より頂いた内容です。
件名：ドラフティングで空のシートを削除したい
ドラフティングでDITTを追加したり、いらなくなったDITTを削除できるようにはしたのですが、
削除した空のシートがマクロで削除できなく困っています。
本ページでは上記の通り、空のシートを一括で削除するマクロを紹介していきます。
処理の内容はかなりシンプルなのでマクロ初心者の方でも理解しやすい内容となっています。
マクロの機能
今回作成したマクロは冒頭でもいった通り「空のシートを一括で削除するマクロ」です。
具体的な機能は以下のとおりです。
・削除後に何個のシートを削除したかを表示する
サンプルコード
マクロのコードは以下のとおりです。
コードを実行すると、アクティブドキュメント内の空シートをすべて削除します。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 |
Sub CATMain() 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認 If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then MsgBox "CATDrawingのみ対応のマクロです。" Exit Sub End If 'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義 Dim doc As DrawingDocument Set doc = CATIA.ActiveDocument 'Selection定義 Dim sel As Selection Set sel = doc.Selection sel.Clear '削除するｼｰﾄを格納するｺﾚｸｼｮﾝを用意 Dim del_sht As Collection Set del_sht = New Collection '画面更新を一時的に無効 CATIA.RefreshDisplay = False '空のｼｰﾄをｺﾚｸｼｮﾝに格納 Dim i As Integer For i = 1 To doc.Sheets.Count Dim sht As DrawingSheet Set sht = doc.Sheets.Item(i) sel.Add sht sel.Search ("ﾀｲﾌﾟ=*,sel") '英語環境の場合は「ﾀｲﾌﾟ」を「Type」に変更 'ｼｰﾄ内のｵﾌﾞｼﾞｪｸﾄが12個の場合に空のｼｰﾄと判定 If sel.Count = 12 Then del_sht.Add sht End If sel.Clear Next i '削除するｼｰﾄ(ｺﾚｸｼｮﾝ内のｼｰﾄ)の数を取得 Dim cnt As Integer cnt = del_sht.Count 'ｺﾚｸｼｮﾝ内のｼｰﾄを全て削除 For i = 1 To del_sht.Count sel.Add del_sht.Item(i) Next i sel.Delete '画面更新を有効に戻す CATIA.RefreshDisplay = True MsgBox cnt & "個のシートを削除しました。" End Sub |
コード解説
ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認
|
1 2 3 4 5 |
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認 If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then MsgBox "CATDrawingのみ対応のマクロです。" Exit Sub End If |
まず、はじめにアクティブドキュメントの定義をします。
今回のマクロはCATDrawingでのみ有効なものなので、アクティブドキュメントがCATDrawing以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ/Selectionの定義
|
1 2 3 4 5 6 7 8 |
'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義 Dim doc As DrawingDocument Set doc = CATIA.ActiveDocument 'Selection定義 Dim sel As Selection Set sel = doc.Selection sel.Clear |
アクティブドキュメントとSelectionの定義を行います。
Selectionオブジェクトはシート内で検索(Searchメソッド)を使うために定義します。
最終的にはシート内検索の結果から空のシートかそうでないかを判断します。
削除するｼｰﾄを格納するｺﾚｸｼｮﾝを用意
|
1 2 3 |
'削除するｼｰﾄを格納するｺﾚｸｼｮﾝを用意 Dim del_sht As Collection Set del_sht = New Collection |
削除するシートを格納しておくためのコレクションを用意しておきます。
上記でもいったとおりシート内検索を行いますが、CATIA VBAでは削除する際にも検索する際にもオブジェクトを選択状態にする必要があります。
そのため、一旦削除するシートをすべてコレクションに格納し、全てを格納し終えてからまとめて削除するという処理の流れにしています。
空のｼｰﾄをｺﾚｸｼｮﾝに格納
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
'空のｼｰﾄをｺﾚｸｼｮﾝに格納 Dim i As Integer For i = 1 To doc.Sheets.Count Dim sht As DrawingSheet Set sht = doc.Sheets.Item(i) sel.Add sht sel.Search ("ﾀｲﾌﾟ=*,sel") '英語環境の場合は「ﾀｲﾌﾟ」を「Type」に変更 'ｼｰﾄ内のｵﾌﾞｼﾞｪｸﾄが12個の場合に空のｼｰﾄと判定 If sel.Count = 12 Then del_sht.Add sht End If sel.Clear Next i |
先ほど用意したコレクションに削除するシート(空のシート)を全て格納します。
空シートの判定はシート内で条件を絞らずに全てのオブジェクトに対しての検索を行ったときの「検索結果のオブジェクトの数」より行います。
シート内には削除ができない「絶対座標系」や「MainView」「BackgroundView」などの、計12個のオブジェクトが存在します。つまり、検索結果のオブジェクトの数が12個だった場合のみ空のシートであると判定することができます。
この処理をアクティブドキュメント内のすべてのシートに対して行い、空シートと判断されたシートは「del_sht」コレクションに格納していきます。
ｺﾚｸｼｮﾝ内のｼｰﾄを全て削除
|
1 2 3 4 5 |
'ｺﾚｸｼｮﾝ内のｼｰﾄを全て削除 For i = 1 To del_sht.Count sel.Add del_sht.Item(i) Next i sel.Delete |
最後にコレクション内のシートをすべて削除します。
ループ文を使ってコレクション内のシートをすべて選択した状態にしてから、「sel.Delete」でまとめて削除しています。
まとめ
今回は「空のシートを一括で削除するマクロ」についての内容でした。
処理自体はかなり単純で、重要なのは「空のシートをどのようにして判定するか」の部分だけです。
今回のマクロではオブジェクトの数で空のシートを判定しましたが、その他の方法もいくつかあると思うのでサンプルコードはあくまでも参考程度にご利用下さい。
CATIAマクロを本気で勉強するなら
