ExcelファイルをAutoCADの表として出力するマクロ｜AutoCAD VBAマクロの作成方法

AutoCADにはExcelファイルを表としてDrawingに貼り付けることができる標準機能が用意されています。ただこの機能はあくまでもExcelの情報をそのまま表に変換されるものであり、たとえば複数のExcelの情報を集計してその結果を表に出力したいというような動的な処理は行うことができません。

このような細かい操作をしながらExcelの情報をAutoCADの表として作成する際にVBAを使うことで、AutoCADの標準機能ではできない処理を実現することができます。本ページでは複雑な処理は避け、Excelファイルをそのまま表にするだけの基本的なコードを解説します。

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

AutoCAD VBAでExcelを操作する方法｜AutoCAD VBAマクロの作成方法

本ページではAutoCAD VBAでExcelを操作する方法を解説していきます。 AutoCADとExcelと連携することで ...

https://liclog.net/export-excel-macro-vba-autocad/

1. ExcelファイルをAutoCADの表として出力
2. サンプルコード
3. コード解説　
4. まとめ

ExcelファイルをAutoCADの表として出力

AutoCADの表はVBA上ではTableオブジェクトとして扱われます。TableオブジェクトはModelSpace/PaperSpaceオブジェクト等のAddTableメソッドを使うことで作成することができます。

作成したTableオブジェクトは同オブジェクトが持つメソッドを使うことで操作することができます。
例えば下記のような操作を行うことができます。Tableオブジェクトは下記以外の様々なメソッド/プロパティを持っており、行や列を追加したりセルの幅や高さ、色などを変更する等の操作も可能です。

メソッド	内容
SetCellValue	指定のセルの値を設定する
SetCellTextHeight	指定のセルの文字の高さを設定する
SetCellAlignment	指定のセルの位置合わせを設定する
SetCellDataType	指定のセルのデータ形式を設定する
MergeCells	指定範囲のセルを結合する
UnmergeCells	指定範囲のセルの結合を解除する

　
Excel VBAの場合、セルの始まりの番地は (1,1) と表しますが、AutoCAD VBAのTableオブジェクトの場合はセルの始まりの番地は (0,0) となっておりズレが存在しているため注意が必要です。

サンプルコード

下記は指定したExcelファイルに記載されている表のデータを取得して、AutoCADの表として新規作成するためのサンプルコードです。サンプルコードではExcelから取得している情報はあくまでも文字データのみで、セルの大きさや結合セル、フォントや色などは対象外となっています。

Option Explicit
'*****************************************************************************
'*  ﾒｲﾝ関数
'*****************************************************************************
Sub main()

    Dim oTable As AcadTable
    Dim sPathExcel As String
    
    'Excelﾌｧｲﾙﾊﾟｽ指定
    sPathExcel = "C:\...\Table.xlsx"

    'Excelから表作成
    Set oTable = ImportTableData(sPathExcel, 0, 0, 10)

End Sub
'-----------------------------------------------------------------------------
'-  Excelを表として出力する
'-      sPathExcel  ：Excelﾌｧｲﾙﾊﾟｽ (1つ目のｼｰﾄが対象)
'-      dX          ：X座標
'-      dY          ：Y座標
'-      (dZ)        ：Z座標
'-----------------------------------------------------------------------------
Function ImportTableData(ByVal sPathExcel As String, _
                         ByVal dX As Double, _
                         ByVal dY As Double, _
                         Optional ByVal dZ As Double = 0) As AcadTable

    Dim oExcel As Object
    Dim wbImport As Object 'Workbook
    Dim wsImport As Object 'Worksheet
    Dim vDatas As Variant
    Dim oTable As AcadTable
    Dim arr_dPos(0 To 2) As Double
    Dim r As Long
    Dim c As Long
    
    '入力ﾊﾟｽからExcelﾌｧｲﾙを裏側で開く
    Set oExcel = CreateObject("Excel.Application")
    Set wbImport = oExcel.Workbooks.Open(sPathExcel)
    Set wsImport = wbImport.Worksheets.Item(1)
    
    'ﾃﾞｰﾀ取得 (※表はA1ｾﾙから始まっている必要あり)
    vDatas = wsImport.Cells(1, 1).CurrentRegion
    
    'Excel終了
    Call oExcel.Quit

    'ﾃｰﾌﾞﾙ作成位置定義
    arr_dPos(0) = dX
    arr_dPos(1) = dY
    arr_dPos(2) = dZ
    
    'ﾃｰﾌﾞﾙ作成
    Set oTable = ThisDrawing.ModelSpace.AddTable(arr_dPos, UBound(vDatas, 1), UBound(vDatas, 2), 20, 50)
    
    'ﾀｲﾄﾙ部のﾏｰｼﾞを解除
    Call oTable.UnmergeCells(0, 0, oTable.Rows - 1, oTable.Columns - 1)

    'Excelから取得したﾃﾞｰﾀをﾃｰﾌﾞﾙに転記
    For r = 1 To UBound(vDatas, 1)
        For c = 1 To UBound(vDatas, 2)
        
            'ｾﾙのﾃﾞｰﾀ形式を[文字列]に設定
            Call oTable.SetCellDataType(r - 1, c - 1, acString, acUnitless)
            
            'ｾﾙの位置合わせを[中央]に設定
            Call oTable.SetCellAlignment(r - 1, c - 1, acMiddleCenter)
            
            'ｾﾙの文字高さを設定
            Call oTable.SetCellTextHeight(r - 1, c - 1, 6)
            
            If IsEmpty(vDatas(r, c)) = False Then

                'ｾﾙにﾃﾞｰﾀの値を入力 (※数値ﾃﾞｰﾀの場合は文字列に変換)
                If IsNumeric(vDatas(r, c)) Then
                    Call oTable.SetCellValue(r - 1, c - 1, CStr(vDatas(r, c)))
                Else
                    Call oTable.SetCellValue(r - 1, c - 1, vDatas(r, c))
                End If
            End If
        Next
    Next
    
    '画面再描画
    Call ThisDrawing.Regen(acAllViewports)

    '戻り値設定
    Set ImportTableData = oTable

End Function

Option Explicit

'*****************************************************************************

'* ﾒｲﾝ関数

'*****************************************************************************

Sub main()

Dim oTable As AcadTable

Dim sPathExcel As String

'Excelﾌｧｲﾙﾊﾟｽ指定

sPathExcel = "C:\...\Table.xlsx"

'Excelから表作成

Set oTable = ImportTableData(sPathExcel, 0, 0, 10)

End Sub

'-----------------------------------------------------------------------------

'- Excelを表として出力する

'- sPathExcel ：Excelﾌｧｲﾙﾊﾟｽ (1つ目のｼｰﾄが対象)

'- dX ：X座標

'- dY ：Y座標

'- (dZ) ：Z座標

'-----------------------------------------------------------------------------

Function ImportTableData(ByVal sPathExcel As String, _

ByVal dX As Double, _

ByVal dY As Double, _

Optional ByVal dZ As Double = 0) As AcadTable

Dim oExcel As Object

Dim wbImport As Object 'Workbook

Dim wsImport As Object 'Worksheet

Dim vDatas As Variant

Dim oTable As AcadTable

Dim arr_dPos(0 To 2) As Double

Dim r As Long

Dim c As Long

'入力ﾊﾟｽからExcelﾌｧｲﾙを裏側で開く

Set oExcel = CreateObject("Excel.Application")

Set wbImport = oExcel.Workbooks.Open(sPathExcel)

Set wsImport = wbImport.Worksheets.Item(1)

'ﾃﾞｰﾀ取得 (※表はA1ｾﾙから始まっている必要あり)

vDatas = wsImport.Cells(1, 1).CurrentRegion

'Excel終了

Call oExcel.Quit

'ﾃｰﾌﾞﾙ作成位置定義

arr_dPos(0) = dX

arr_dPos(1) = dY

arr_dPos(2) = dZ

'ﾃｰﾌﾞﾙ作成

Set oTable = ThisDrawing.ModelSpace.AddTable(arr_dPos, UBound(vDatas, 1), UBound(vDatas, 2), 20, 50)

'ﾀｲﾄﾙ部のﾏｰｼﾞを解除

Call oTable.UnmergeCells(0, 0, oTable.Rows - 1, oTable.Columns - 1)

'Excelから取得したﾃﾞｰﾀをﾃｰﾌﾞﾙに転記

For r = 1 To UBound(vDatas, 1)

For c = 1 To UBound(vDatas, 2)

'ｾﾙのﾃﾞｰﾀ形式を[文字列]に設定

Call oTable.SetCellDataType(r - 1, c - 1, acString, acUnitless)

'ｾﾙの位置合わせを[中央]に設定

Call oTable.SetCellAlignment(r - 1, c - 1, acMiddleCenter)

'ｾﾙの文字高さを設定

Call oTable.SetCellTextHeight(r - 1, c - 1, 6)

If IsEmpty(vDatas(r, c)) = False Then

'ｾﾙにﾃﾞｰﾀの値を入力 (※数値ﾃﾞｰﾀの場合は文字列に変換)

If IsNumeric(vDatas(r, c)) Then

Call oTable.SetCellValue(r - 1, c - 1, CStr(vDatas(r, c)))

Else

Call oTable.SetCellValue(r - 1, c - 1, vDatas(r, c))

End If

'画面再描画

Call ThisDrawing.Regen(acAllViewports)

'戻り値設定

Set ImportTableData = oTable

End Function

コード解説　

Excel情報取得

AutoCAD VBAでExcel VBAを利用できるようにするためには、ExcelオブジェクトをCreateObjectで作成する必要があります。(※詳しくはAutoCAD VBAでExcelを操作する方法を参照ください)

出力するデータの対象のシートは「Item(1)」、表も「Cells(1, 1).CurrentRegion」というように決め打ちのコードとなっています。この取得方法は適宜入力データに合わせて変更する必要があります。

データ取得後は2次元配列にデータが格納され、Excel自体は不要になるのでデータ取得直後に終了させています。この終了処理が行われないとバックグラウンドでExcelが開き続けてしまうので注意が必要です。デバッグエラーで途中で止まってしまい終了処理が行われなかった場合も裏に残ってしまうため、基本的には不要になったタイミングで即時終わらせるほうが安心です。

バックグラウンドに残ってしまったExcelはタスクマネージャから手動で終了させることができます。
　　

表(Table)作成

表はModelSpaceオブジェクトのAddTableメソッドを使い作成し、タイトルが含まれることを考慮してUnmergeCellsメソッドを使って1行目全体に対してセル結合を解除する処理を行っています。

空の表が作成されたらExcelから取得したデータを各セルに入力していきます。このとき下記のメソッドを使い、セルのデータ形式やテキストの高さ、テキストの位置合わせの設定もまとめて行います。

　 
    'セルのデータ形式設定
    Call oTable.SetCellDataType(行番号, 列番号, データ形式, 単位タイプ)
 
    'セルの位置合わせ設定
    Call oTable.SetCellAlignment(行番号, 列番号, 位置)
 
    'セルの文字高さ変更
    Call oTable.SetCellTextHeight(行番号, 列番号, 文字高さ)
 
    'セルの値変更
    Call oTable.SetCellValue(行番号, 列番号, 値)

'セルのデータ形式設定

Call oTable.SetCellDataType(行番号, 列番号, データ形式, 単位タイプ)

'セルの位置合わせ設定

Call oTable.SetCellAlignment(行番号, 列番号, 位置)

'セルの文字高さ変更

Call oTable.SetCellTextHeight(行番号, 列番号, 文字高さ)

'セルの値変更

Call oTable.SetCellValue(行番号, 列番号, 値)

セルを設定するメソッドは行番号と列番号から特定のセルを指定し、そのセルに対して任意の設定を行います。Excelから行列を2次元配列化したデータの取得はできているので、そのデータでループを行い1セルずつ設定と値の入力をしています。このときセルの番地はExcelと少し違うので調整が必要です。

また、セルに設定する値が数値データの場合はCStr関数を使ってString型に変換してからSetCellValueメソッドに入力しています。これは直接数値データを入力したときに表記が変わってしまう問題を避けるための処理です。(※例えば「1」が「1.0000」のようになる)
　

まとめ

今回はExcelで作成した表をAutoCADの表としてに書き出す方法についての内容でした。

サンプルコードではセルを設定するために4つのメソッドしか使っていませんが、オンラインヘルプを確認するとわかる通りTableオブジェクトには大量のメソッドが用意されています。「SetCell～」系メソッドであれば基本的にはセルを指定するための行数/列数と設定する情報を入力するだけなので、サンプルコードの内容が理解できればすぐに使いこなせると思います。

より細かい設定を行いたい場合はより多くのメソッドを使う必要があるため、実際にいろいろ使ってみて機能の確認をしてみてください。Tableオブジェクトのメソッド/プロパティを使いこなせるようになればAutoCADの表を自由自在に編集することが可能になります。
　

メインページへ戻る