Excel上で指定した範囲をCATDrawingのテーブルとして出力するマクロ｜CATIAマクロの作成方法

今回の記事は「マクロ案」よりいただいた内容です。
送って頂いた内容は以下のようなマクロです。

ワークベンチ：ドラフティング

マクロ案: excelで特定の領域をDragした一部分をCATIAのtableで生成する方法を知りたいです。

VBAではマクロ実行後の処理が終わるまでExcelの領域を指定することはできませんが、UserFormを使用すればこれが可能になります。今回はUserFormとコードが分かれるためコードの詳細は解説していません。どうしても解説が欲しい場合は「お問い合わせ」よりご連絡ください。

1. マクロの機能
2. VBAコード
3. まとめ

マクロの機能

今回作成したのはExcel上で指定した範囲をCATDrawingのテーブルとして出力するマクロです。
具体的な機能は以下のとおりです。

マクロの機能まとめ・Excel上で指定した範囲をCATDrawingのテーブルとして出力する
・指定範囲内が空白でも指定範囲と同じサイズのテーブルが出力される
・作成位置はクリックで指定可能(上画像の操作手順⑤)
・セルが結合されている部分は非対応(結合していないものとして出力)

また、今回のサンプルマクロではUserFormを使用するので、上画像のようなフォームを作成しておきましょう。このときUserForm名称は「Export_table」、ボタン名称は「CommandButton1」にしておいてください。

VBAコード

コード全体は下記の通りです。
標準モジュールとUserFormの2つのコードがあるので注意して下さい。
また、CATIA VBAでExcelの操作をするためには設定をする必要があります。
CATIAマクロでExcelを操作する方法を参考に事前に設定しておきましょう。

お問い合わせ頂いた内容の処理はできるようになっていますが、UIがかなりヒドいのでUserForm上に操作手順を書いたり、次にどんな操作をするかがわかりやすくなるような処理を追加する等をオススメします。
　

標準モジュールコード

Option Explicit
Public appExcel As Excel.Application
Sub CATMain()

    Set appExcel = CreateObject("Excel.Application")
    
 'ﾃｰﾌﾞﾙに出力するExcelﾌｧｲﾙを開く
    Dim fn As String
    fn = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx")
    If fn <> "False" Then
        Dim wb As Workbook
        Set wb = appExcel.Workbooks.Open(fn)
        appExcel.Visible = True
    Else
        MsgBox "キャンセルしました。"
        Exit Sub
    End If

 'UserFormを開く：開いたExcelの出力するｾﾙを選択した状態でﾎﾞﾀﾝを押して実行
    Export_table.Show vbModeless

End Sub

Option Explicit

Public appExcel As Excel.Application

Sub CATMain()

Set appExcel = CreateObject("Excel.Application")

'ﾃｰﾌﾞﾙに出力するExcelﾌｧｲﾙを開く

Dim fn As String

fn = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx")

If fn <> "False" Then

Dim wb As Workbook

Set wb = appExcel.Workbooks.Open(fn)

appExcel.Visible = True

Else

MsgBox "キャンセルしました。"

Exit Sub

End If

'UserFormを開く：開いたExcelの出力するｾﾙを選択した状態でﾎﾞﾀﾝを押して実行

Export_table.Show vbModeless

End Sub

　
UserFormコード

Option Explicit
Private Sub CommandButton1_Click()

    Me.Hide

    Dim doc As DrawingDocument:     Set doc = CATIA.ActiveDocument
    Dim sht As DrawingSheet:        Set sht = doc.Sheets.ActiveSheet
    Dim vw As DrawingView:          Set vw = sht.Views.ActiveView
    
 'ﾕｰｻﾞｰ選択で位置の座標を取得
    Dim sel 'As Selection
    Set sel = doc.Selection
    
    Dim msg As String
    msg = "点もしくは図面内の任意の地点をクリックしてください。"
        
    Dim filter
    filter = Array("Point2D")
        
    Dim flg As Boolean
    Dim coord(1)
    Dim res As String
        
    res = sel.IndicateOrSelectElement2D(msg, filter, False, False, False, flg, coord)
    If res = "Normal" Then
        If flg = True Then
            Dim selPoint 'As Point2D
            Set selPoint = sel.Item(1).Value
            selPoint.GetCoordinates coord
        End If
    Else
        MsgBox "キャンセルします。"
        Exit Sub
    End If
    
    Dim selArea As Range
    Set selArea = appExcel.Selection
    
 'ﾃｰﾌﾞﾙ作成
    Dim tbl As DrawingTable
    
    If selArea.Count = 1 Then
        Set tbl = vw.Tables.Add(coord(0), coord(1), 1, 1, _
                                selArea.RowHeight / 2, selArea.ColumnWidth * 4)
        Call tbl.SetCellString(1, 1, selArea.Value2)
    Else
        Set tbl = vw.Tables.Add(coord(0), coord(1), _
                                UBound(selArea.Value2, 1), UBound(selArea.Value2, 2), _
                                selArea.RowHeight / 2, selArea.ColumnWidth * 4)
        Dim i As Long
        Dim j As Long
        Dim ex_val As String
        For i = 1 To UBound(selArea.Value2, 1)
            For j = 1 To UBound(selArea.Value2, 2)
                ex_val = selArea.Value2(i, j)
                Call tbl.SetCellString(i, j, ex_val)
            Next j
        Next i
    End If
                             
    appExcel.ActiveWorkbook.Close
    Unload Me
    MsgBox "テーブルに書き出しました。"

End Sub