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ファイルの表と同じ並びでセルの値がまとまって出力されます。
具体的な機能は以下のとおりです。
・出力先はアクティブなビューもしくはシート
・選択した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メソッド」を使います。
DrawingTexts.Add テキストボックスに入力する値,X座標位置,Y座標位置
上記までに「テキストボックスに入力する値」「X座標位置」「Y座標位置」はすべて作成しているので、あとは対応する変数を入れていくだけです。
まとめ
今回はExcelで作成した表を1つのテキストボックスに出力するマクロについての内容でした。
サンプルコードの「txt」の中身の作り方を変更すれば、任意の"かたち"でテキストボックスに出力することができます。(たとえば半角スペースをカンマ[,]に書き換えるだけでcsv形式のような形で出力できます)
ようは今回の内容で重要なのは「txt」の中身をどのように作るかです。
自身の環境に合わせた出力形式にすることもできると思うので、区切り文字が半角スペースだと不便という場合はいい感じに書き換えてみて下さい。











