空のシートを一括で削除するマクロ｜CATIAマクロの作成方法

今回は「お問い合わせ」より頂いた内容です。

件名：ドラフティングで空のシートを削除したい
ドラフティングでDITTを追加したり、いらなくなったDITTを削除できるようにはしたのですが、
削除した空のシートがマクロで削除できなく困っています。

本ページでは上記の通り、空のシートを一括で削除するマクロを紹介していきます。
処理の内容はかなりシンプルなのでマクロ初心者の方でも理解しやすい内容となっています。

 

マクロの機能

今回作成したマクロは冒頭でもいった通り「空のシートを一括で削除するマクロ」です。

具体的な機能は以下のとおりです。

 

サンプルコード

マクロのコードは以下のとおりです。
コードを実行すると、アクティブドキュメント内の空シートをすべて削除します。

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

 

コード解説

ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認

  'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ確認
    If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
        MsgBox "CATDrawingのみ対応のマクロです。"
        Exit Sub
    End If

まず、はじめにアクティブドキュメントの定義をします。
今回のマクロはCATDrawingでのみ有効なものなので、アクティブドキュメントがCATDrawing以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
　

ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ/Selectionの定義

  'ｱｸﾃｨﾌﾞﾄﾞｷｭﾒﾝﾄ定義
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
  'Selection定義
    Dim sel As Selection
    Set sel = doc.Selection
    sel.Clear

アクティブドキュメントとSelectionの定義を行います。
Selectionオブジェクトはシート内で検索(Searchメソッド)を使うために定義します。
最終的にはシート内検索の結果から空のシートかそうでないかを判断します。
 

削除するｼｰﾄを格納するｺﾚｸｼｮﾝを用意

  '削除するｼｰﾄを格納するｺﾚｸｼｮﾝを用意
    Dim del_sht As Collection
    Set del_sht = New Collection

削除するシートを格納しておくためのコレクションを用意しておきます。
上記でもいったとおりシート内検索を行いますが、CATIA VBAでは削除する際にも検索する際にもオブジェクトを選択状態にする必要があります。

そのため、一旦削除するシートをすべてコレクションに格納し、全てを格納し終えてからまとめて削除するという処理の流れにしています。
　

空のｼｰﾄをｺﾚｸｼｮﾝに格納

  '空のｼｰﾄをｺﾚｸｼｮﾝに格納
    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」コレクションに格納していきます。
　

ｺﾚｸｼｮﾝ内のｼｰﾄを全て削除

  'ｺﾚｸｼｮﾝ内のｼｰﾄを全て削除
    For i = 1 To del_sht.Count
        sel.Add del_sht.Item(i)
    Next i
    sel.Delete

最後にコレクション内のシートをすべて削除します。
ループ文を使ってコレクション内のシートをすべて選択した状態にしてから、「sel.Delete」でまとめて削除しています。

 

まとめ

今回は「空のシートを一括で削除するマクロ」についての内容でした。

処理自体はかなり単純で、重要なのは「空のシートをどのようにして判定するか」の部分だけです。

今回のマクロではオブジェクトの数で空のシートを判定しましたが、その他の方法もいくつかあると思うのでサンプルコードはあくまでも参考程度にご利用下さい。
　

サンプルマクロ集に戻る
目次へ戻る
 

icon-book CATIAマクロを本気で勉強するなら