ｱｸﾃｨﾌﾞなｼｰﾄの全てのﾋﾞｭｰの2Dｺﾝﾎﾟｰﾈﾝﾄを全て展開する

結構忙しかった為、すっかり更新をサボっておりました。

こちらのﾏｸﾛは、これ単体で利用する事を目的としたものでは
無いのですが、過去に必要になった為作成しました。
ﾀｲﾄﾙ通り、全ての2Dｺﾝﾎﾟｰﾈﾝﾄを展開するだけです。

'アクティブなSheetのメインと背景以外のViewにある2Dコンポーネントの展開
Sub CATMain()
    Dim Msg As String
    Dim oDoc As DrawingDocument
    Dim oviews As DrawingViews
    Dim oSel As selection
    Dim oComp As DrawingComponent
    Dim i As Integer
    Dim ExpCount As Integer
    Dim CompList As New Collection '2Dコンポーネントが存在するViewのID
    
    'メインと背景以外の各Viewの2Dコンポーネント数のカウント
    Set oDoc = CATIA.ActiveDocument
    Set oviews = oDoc.Sheets.ActiveSheet.Views
    Msg = "現シートには" + vbCrLf
    ExpCount = 0
    For i = 3 To oviews.Count
        With oviews.Item(i)
            If .Components.Count > 0 Then
                Msg = Msg + "「" + .Name + ":" + CStr(.Components.Count) + "個」" + vbCrLf
                ExpCount = ExpCount + 1
                Call CompList.add(i)
            End If
        End With
    Next
    If ExpCount = 0 Then
        Msg = Msg + "2Dコンポーネントが存在していませんでした"
        MsgBox (Msg)
        Exit Sub
    End If
    Msg = Msg + "の2Dコンポーネントが存在し展開します。元には戻せないため、" + vbCrLf
    Msg = Msg + "予めSheetのコピー等を行うことをお勧めします。" + vbCrLf
    Msg = Msg + "処理を行いますか？"
    Result = MsgBox(Msg, vbOKCancel + vbInformation)
    If Result = vbCancel Then Exit Sub
    
    '2Dコンポーネントの展開
    Set oSel = oDoc.selection
    ExpCount = 0
    For Each ID In CompList
        For Each oComp In oviews.Item(ID).Components
            oComp.Explode
            With oSel
                .Clear
                .add oComp
                .Delete
            End With
            ExpCount = ExpCount + 1
        Next
    Next
    Msg = CStr(ExpCount) + "個、展開しました。"
    MsgBox (Msg)
End Sub