ExcelファイルをCATDrawingのテキストボックスに出力するマクロ|CATIAマクロの作成方法
今回のページは「お問い合わせ」から頂いたマクロ作成についての内容です。
Excelのリストを、テーブルではなく、 それぞれドラフティングのテキストボックスに
書き出す方法がありますでしょうか?例:ExcelのA列に上から5つの文字列が入っている場合、
それぞれをドラフティングのテキストボックスとして書き出す。( テキストボックスが5つできる。)
テキストボックスの位置は、 Excelと同じように配置出来たらよい。
上記の通り、以前に公開した「ExcelファイルをCATDrawingのテーブルに出力するマクロ」の出力方法をテーブルではなく、テキストボックスにしたバージョンのマクロを作成していきます。
Excelとの連携方法は下記ページで解説しているので先に一読しておくことをオススメします。
マクロの機能
マクロの機能は「Excelファイルのテキストボックスとして出力する」です。
このとき各セルごとに別々のテキストボックスで出力されます。
(上画像の場合は25個のテキストボックスが作成されている)
出力後のテキストボックスはExcelファイルの各セルと同じ位置関係になるように配置されます。
・出力先はアクティブなビューもしくはシート
・選択したExcelファイルにならってテキストボックスは配置される
・Excelファイルの表の中で空白の部分は空白のテキストボックスが作成される
サンプルコード
マクロのコードは下記のとおりです。
マクロ実行後に選択したExcelファイルの値をテキストボックスとして書き出します。
※エラーが出る場合はおそらくExcelライブラリが読み込まれていません
詳しくは後述のコード解説「Excelの定義」の項を参照ください。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 |
Sub CATMain() Dim DrwDOC As DrawingDocument 'DrawingDocument(CATDrawing)として宣言' If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then 'アクティブドキュメントがDrawingDocumentか確認' MsgBox "このマクロはDrawingDocument専用です。" _ & vbLf & _ "ドラフティングワークベンチに切り替えて実行してください。" Exit Sub 'DrawingDocumentでない場合はマクロを終了' End If Set DrwDOC = CATIA.ActiveDocument Dim appExcel As Object Set appExcel = CreateObject("Excel.Application") Dim OpenFileName As String OpenFileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx") 'Excelファイルの選択' If OpenFileName <> "False" Then Dim WB As Workbook Set WB = Workbooks.Open(OpenFileName) Else MsgBox "キャンセルされました" Exit Sub End If Dim WS As Worksheet Set WS = WB.Sheets(1) '選択されたExcelの1つ目にあるシートを定義' Dim MaxRow As Integer Dim MaxCol As Integer With WS.UsedRange MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column End With Dim DS As DrawingSheet Set DS = DrwDOC.Sheets.ActiveSheet 'アクティブなシートを定義' Dim VIW As DrawingView Set VIW = DS.Views.ActiveView 'アクティブなビューを定義' Dim OriginX As Single Dim OriginY As Single OriginX = 30 '配置の基準となるX座標を指定' OriginY = 50 '配置の基準となるY座標を指定' Dim i As Integer Dim j As Integer For i = 1 To MaxRow For j = 1 To MaxCol Dim ExcelTXT As String ExcelTXT = WS.Cells(i, j).Value VIW.Texts.Add ExcelTXT, OriginX + ((j - 1) * 15), OriginY + ((i - 1) * -7) Next j Next i WB.Close False End Sub |
コード解説
本マクロのコードを上から順に部分ごとにわけて解説していきます。
前半の内容は以前に公開した「ExcelファイルをCATDrawingのテーブルに出力するマクロ」と全く同じ内容になっています。
アクティブドキュメントの定義
1 2 3 4 5 6 7 8 9 |
Dim DrwDOC As DrawingDocument If TypeName(CATIA.ActiveDocument) <> "DrawingDocument" Then MsgBox "このマクロはDrawingDocument専用です。" & vbLf & _ "ドラフティングワークベンチに切り替えて実行してください。" Exit Sub End If Set DrwDOC = CATIA.ActiveDocument |
まずはじめにアクティブドキュメントの定義をします。
今回のマクロはCATDrawingでのみ有効なものなので、アクティブドキュメントがCATDrawing以外の場合はTypeName関数を使った条件分岐でマクロを終了するようにしています。
条件分岐の先、つまりはアクティブドキュメントがCATDrawingの場合は変数「DrwDOC」にアクティブドキュメントを代入します。
Excelの定義
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
Dim Excel As Object Set Excel = CreateObject("Excel.Application") Dim OpenFileName As String OpenFileName = Application.GetOpenFilename(FileFilter:="Excelファイル,*.xlsx") If OpenFileName <> "False" Then Dim WB As Workbook Set WB = Workbooks.Open(OpenFileName) Else MsgBox "キャンセルされました" Exit Sub End If Dim WS As Worksheet Set WS = WB.Sheets(1) |
CATIAマクロ上でExcel VBAを使用できるようにExcelを定義します。
上記コードでExcelが定義できない場合は、参照設定がされていない可能性があります。
詳しくは下記ページの「Excelマクロのライブラリを読み込む」の項を一読ください。
Excelを定義後は「GetOpenFilenameメソッド」を使って、
出力元となるExcelファイル(ブック)をユーザーに選択させ、変数「WB」として代入します。
変数「WB」を定義したら、WBの1つ目のシートを変数「WS」に代入します。
このWSに書かれている値がテキストボックスとして出力されます。
Excelファイルの最大行数/列数を取得
1 2 3 4 5 6 7 |
Dim MaxRow As Integer Dim MaxCol As Integer With WS.UsedRange MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column End With |
出力元となるExcelの表のサイズ、つまりは値が入力されている最大行数/列数を取得します。
これは「Findメソッド」を使うことで簡単に取得することができます。
「Findメソッド」を使った入力範囲の取得はExcelマクロでよく使われ、多くの情報が存在するのでここでは割愛します。(詳しくは「Excelマクロ Findメソッド」等で検索してみて下さい)
取得した値はそれぞれ、最大行数は「MaxRow」、最大列数は「MaxCol」に代入します。
テキストボックス作成の準備
1 2 3 4 5 6 7 8 9 10 |
Dim DS As DrawingSheet Set DS = DrwDOC.Sheets.ActiveSheet 'アクティブなシートを定義 Dim VIW As DrawingView Set VIW = DS.Views.ActiveView 'アクティブなビューを定義 Dim OriginX As Single Dim OriginY As Single OriginX = 30 '配置の基準となるX座標を指定 OriginY = 50 '配置の基準となるY座標を指定 |
出力先となるアクティブなシート/ビューを定義します。
合わせて出力位置の「基準となる座標」を指定します。
基準となる座標とは、下の画像のように出力するすべてのテキストボックスを1つのかたまりとして見たときの左上の位置のことを指します。
この位置を基準にすべてのテキストボックスが配置されていくので任意で値を変更して下さい。
テキストボックスの作成
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Dim i As Integer Dim j As Integer For i = 1 To MaxRow For j = 1 To MaxCol Dim ExcelTXT As String ExcelTXT = WS.Cells(i, j).Value VIW.Texts.Add ExcelTXT, OriginX + ((j - 1) * 15), OriginY + ((i - 1) * -7) Next j Next i |
Excelの各セルから値を読み取り、テキストボックスとして出力していきます。
テキストボックスは取得したMaxRow×MaxCol回のループで、1つずつ作成していきます。
テキストボックスの作成は「DrawaingTextsコレクション」の「Addメソッド」を使います。
DrawingTexts.Add テキストボックスに入力する値,X座標位置,Y座標位置
テキストボックスの作成位置は先ほど指定した「基準となる座標」を使って以下のようにしています。
X座標: OriginX + ((j – 1) * 15)
Y座標: OriginY + ((i – 1) * -7)
赤色部の数値を変更することでテキストボックス同士の幅を変更することができます。
こちらも基本となる座標と同様に任意で数値を書き換えて下さい。
まとめ
今回はExcelで作成した表をテキストボックスとして出力するマクロについての内容でした。
基本的にはテーブルに書き出すときと同じような処理をしています。
ただテーブルと違い、今回はテキストボックスを配置する位置を指定する必要があります。
上記のコードでは定数で位置を指定しているため、Excelファイルの方でセルの幅や高さを変えても書き出し時に反映されません。
Excelのセル幅、セル高さを取得して今回のマクロに取り込めば、よりExcelファイルに近い形でテキストボックスを出力することできるのでぜひ挑戦してみて下さい。