CATDrawingでExcelファイルを1つのテキストボックスに出力するマクロ|CATIAマクロの作成方法

今回のページは「お問い合わせ」から頂いたマクロ作成についての内容です。

ExcelファイルをCATDrawingのテキストボックスに出力するマクロ」という内容が以前ありましたが、Excelのリストをセルごとのテキストボックスを作るのではなく、1つのテキストボックスに書き出す方法がありますのでしょうか?

例:ExcelのA列B列にそれぞれ文字列が入っており、尚且つ複数行あった場合、1行目A列B列⇒改行⇒2行目A列B列⇒…etc. とテキストボックスに入力されるようにしたい。
イメージとしてはExcelのリストをメモ帳にコピーしたような表示になってほしい。

これまでにExcelファイルをCATDrawingに出力する方法として2つのマクロを作成しました。
ExcelファイルをCATDrawingのテーブルに出力するマクロ (テーブル出力)
ExcelファイルをCATDrawingのテキストボックスに出力するマクロ (テキストボックス出力)

今回は上記と同じくテキストボックス出力ですが、Excelファイルの内容を1つのテキストボックスにまとめて出力します。処理内容はこれまでと同じで「①Excelのセル情報を取得」「②テキストボックス(もしくはテーブル)に取得情報を入れて出力」です。
つまり、Excelファイルの情報を1つのテキストボックスに出力できるような体裁になるようにちょっと細工をすれば、上記リンクのマクロとほとんど同じ処理でOKです。

今回のマクロは「ExcelファイルをCATDrawingのテキストボックスに出力するマクロ」をベースに少し書き換えて作成しているので、未読の方は先にそちらから読んでいただくことをオススメします。

また、Excelとの連携は下記ページで解説しているので同様に一読しておくことをオススメします。

 

マクロの機能

マクロの機能は「Excelファイルを1つのテキストボックスとして出力する」です。
テキストボックスにはExcelファイルの表と同じ並びでセルの値がまとまって出力されます。

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

 icon-wrench マクロの機能まとめ ・選択したExcelファイルの表の値をテキストボックスに出力
・出力先はアクティブなビューもしくはシート
・選択したExcelファイルの表にならって改行を追加
・同行にあるセルの値は出力時に区切りとして半角スペースをいれる

 

サンプルコード

マクロのコードは下記のとおりです。
マクロ実行後に選択したExcelファイルの値をテキストボックスとして書き出します。
※エラーが出る場合はおそらくExcelライブラリが読み込まれていません
 詳しくは後述のコード解説「Excel定義」の項を参照ください。

Sub CATMain()

  'アクティブドキュメント定義
    If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
       MsgBox "このマクロはDrawingDocument専用です。" & vbLf & _
              "ドラフティングワークベンチに切り替えて実行してください。"
       Exit Sub
    End If
    
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
  'Excel定義
    Dim appExcel As Object
    Set appExcel = CreateObject("Excel.Application")
    
  'ユーザー選択でExcelファイル取得
    Dim fn As String
    fn = appExcel.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx")  'Excelファイルの選択
    If fn <> "False" Then
        Dim wb As Workbook
        Set wb = Workbooks.Open(fn)
    Else
        MsgBox "キャンセルされました"
        Exit Sub
    End If
    
    Dim ws As Worksheet
    Set ws = wb.Sheets(1)               '選択されたExcelファイルの1つ目にあるソートを定義
    
    Dim mr As Integer
    Dim mc As Integer
    
    With ws.UsedRange
        mr = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
        mc = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    End With
    
 '出力する値の作成
    Dim r As Long
    Dim c As Long
    Dim chk As Boolean
    Dim txt As String
    Dim exl As String
    
    For r = 1 To mr
        For c = 1 To mc
            exl = CStr(ws.Cells(r, c).Text) 'セルの値が数字の場合は文字列に変換(タイプ不一致エラーの回避用)
            If chk = False Then
                txt = exl
                chk = True
            Else
                txt = txt + " " + exl
            End If
        Next c
        
      '1行毎に改行コードを付ける
        txt = txt + vbLf
        
    Next r
    
    wb.Close False
    
  'アクティブシート定義(CATIA)
    Dim sht As DrawingSheet
    Set sht = doc.Sheets.ActiveSheet
    
  'アクティブビュー定義
    Dim vw As DrawingView
    Set vw = sht.Views.ActiveView
    
    Dim originX As Single
    Dim originY As Single
    originX = 30                        '配置の基準となるX座標を指定
    originY = 50                        '配置の基準となるY座標を指定
    
  'テキストボックス出力
    Dim drwtxt As DrawingText
    Set drwtxt = vw.Texts.Add(txt, originX, originY)

End Sub

 

コード解説

本マクロのコードを上から順に部分ごとにわけて解説していきます。
ExcelファイルをCATDrawingのテキストボックスに出力するマクロ」をベ-スにコードを書き換えているため、全く同じ内容となっている部分もあります。
 

アクティブドキュメント定義

  'アクティブドキュメント定義
    If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then
       MsgBox "このマクロはDrawingDocument専用です。" & vbLf & _
              "ドラフティングワークベンチに切り替えて実行してください。"
       Exit Sub
    End If
    
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument

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

条件分岐の先、つまりはアクティブドキュメントがCATDrawingの場合は変数「doc」にアクティブドキュメントを代入します。
 

Excel定義

  'Excel定義
    Dim appExcel As Object
    Set appExcel = CreateObject("Excel.Application")
    
  'ユーザー選択でExcelファイル取得
    Dim fn As String
    fn = appExcel.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx")  'Excelファイルの選択
    If fn <> "False" Then
        Dim wb As Workbook
        Set wb = Workbooks.Open(fn)
    Else
        MsgBox "キャンセルされました"
        Exit Sub
    End If
    
    Dim ws As Worksheet
    Set ws = wb.Sheets(1)               '選択されたExcelファイルの1つ目にあるソートを定義

CATIAマクロ上でExcel VBAを使用できるようにExcelを定義します。
上記コードでExcelが定義できない場合は、参照設定がされていない可能性があります
詳しくは下記ページの「Excelマクロのライブラリを読み込む」の項を一読ください。

 
Excelを定義後は「GetOpenFilenameメソッド」を使って、
出力元となるExcelファイル(ブック)をユーザーに選択させ、変数「wb」として代入します。

変数「wb」を定義したら、wbの1つ目のシートを変数「ws」に代入します。
このwsに書かれている値がテキストボックスとして出力されます。
 

Excelファイルの最大行数/列数を取得

    Dim mr As Integer
    Dim mc As Integer
    
    With ws.UsedRange
        mr = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
        mc = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    End With

出力元となるExcelの表のサイズ、つまりは値が入力されている最大行数/列数を取得します。

これは「Findメソッド」を使うことで簡単に取得することができます。
「Findメソッド」を使った入力範囲の取得はExcelマクロでよく使われ、多くの情報が存在するのでここでは割愛します。(詳しくは「Excelマクロ Findメソッド」等で検索してみて下さい)

取得した値はそれぞれ、
最大行数は「mr」(max row)、最大列数は「mc」(max column)に代入します。
  

出力する値の作成

 '出力する値の作成
    Dim r As Long
    Dim c As Long
    Dim chk As Boolean
    Dim txt As String
    Dim exl As String
    
    For r = 1 To mr
        For c = 1 To mc
            exl = CStr(ws.Cells(r, c).Text) 'セルの値が数字の場合は文字列に変換(タイプ不一致エラーの回避用)
            If chk = False Then
                txt = exl
                chk = True
            Else
                txt = txt + " " + exl
            End If
        Next c
        
      '1行毎に改行コードを付ける
        txt = txt + vbLf
        
    Next r
    
    wb.Close False

上記で取得したExcelファイル(ws)を元にテキストボックスに出力する値を作成していきます。

これは単純にセル内の文字列を順番にくっつけていけばいいだけです。
mr」「mc」を使って行列ループをし、変数「txt」の後ろにセルの値を付けていきます。
気を付けるべきは「1つ目のセルの対応」と「行が変わる場合は改行する」という2点です。

「1つ目のセル」は値の取得時に「txt」が空の変数なので、条件分岐で1つ目のセルに対する処理とそれ以外の処理で分けています。

「行が変わる場合は改行する」は文字列と同じように改行コード「vbLf」を付けるだけです。
改行コードを付ける処理は行ループ(mr)毎に行います。
  

テキストボックス作成の準備

  'アクティブシート定義(CATIA)
    Dim sht As DrawingSheet
    Set sht = doc.Sheets.ActiveSheet
    
  'アクティブビュー定義
    Dim vw As DrawingView
    Set vw = sht.Views.ActiveView
    
    Dim originX As Single
    Dim originY As Single
    originX = 30                        '配置の基準となるX座標を指定
    originY = 50                        '配置の基準となるY座標を指定

出力先となるアクティブなシート/ビューを定義します。

合わせて出力位置の「基準となる座標」を指定します。
基準となる座標とは、下の画像のように出力するテキストボックスの左上の位置のことです。
(画像は前回の使い回しですが考え方は全く同じです)

この位置を基準にすべてのテキストボックスが配置されていくので任意で値を変更して下さい。
IndicateOrSelectElement2Dメソッド」を使えばユーザーがクリックした位置の座標を取得できるので、このメソッドを使えばユーザーにテキストボックスの作成する位置を決めさせるということもできます。
 

テキストボックス出力

  'テキストボックス出力
    Dim drwtxt As DrawingText
    Set drwtxt = vw.Texts.Add(txt, originX, originY)

Excelの各セルから値を読み取り、テキストボックスとして出力していきます。
テキストボックスの作成は「DrawaingTextsコレクション」の「Addメソッド」を使います。

icon-code Addメソッド

DrawingTexts.Add テキストボックスに入力する値,X座標位置,Y座標位置

上記までに「テキストボックスに入力する値」「X座標位置」「Y座標位置」はすべて作成しているので、あとは対応する変数を入れていくだけです。

 

まとめ

今回はExcelで作成した表を1つのテキストボックスに出力するマクロについての内容でした。

サンプルコードの「txt」の中身の作り方を変更すれば、任意の"かたち"でテキストボックスに出力することができます。(たとえば半角スペースをカンマ[,]に書き換えるだけでcsv形式のような形で出力できます)

ようは今回の内容で重要なのは「txt」の中身をどのように作るかです。
自身の環境に合わせた出力形式にすることもできると思うので、区切り文字が半角スペースだと不便という場合はいい感じに書き換えてみて下さい。
 

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

 

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

2024年8月26日0から学ぶCATIA V5,CATIA,CATIAマクロ