Just in case anyone has a similar problem/question, here is the working (in progress) VBA code that I finally ended up using.
' Sub to create drawing with submittal text
Sub ACADtxt(DataSheet As Worksheet) '
Dim RowCount As Long
Dim iCount As Integer
Dim txtHgt As Double
Dim tmpStrLen1 As Long, tmpStrLen2 As Long
Dim tmpStr1 As String, tmpStr2 As String
Dim ContFlag As String, FROFlag As String
Dim acad As AcadApplication
Dim adoc As AcadDocument
Dim aspace As AcadBlock
Dim Alayer As AcadLayer
Dim entArray() As AcadEntity
Dim ListTable As acadTable
Dim insPt(0 To 2) As Double
'Dim insPt As Variant
' creates a TableStyle object
Dim oDict As AcadDictionary
Dim aColor As New AcadAcCmColor
Dim oTblSty As AcadTableStyle
Dim sKeyName As String
Dim sClassName As String
'On Error Resume Next
On Error GoTo ErrorHandler
Dim appNum As String
appNum = acadVerNum
' See if ACAD is on the computer
If appNum = "" Then
MsgBox "Sorry, but AutoCAD does not appear to exist on this computer.", vbExclamation
Exit Sub
End If
' Color notes http://forums.autodesk.com/t5/Visual-Basic-Customization/Changing-background-color-in-table-cells/td-p/3367317
' Start ACAD
Set acad = CreateObject("Autocad.Application." & appNum)
Set adoc = acad.ActiveDocument
Set aspace = adoc.ActiveLayout.Block
Set aColor = acad.GetInterfaceObject("Autocad.AcCmColor.19")
' Color table http://www.isctex.com/acadcolors.php
aColor.ColorMethod = acColorMethodByACI
' Not visible when not debugging.
'acad.Visible = True
' Create the simplex text style
Dim txtStyle As AcadTextStyle
Set txtStyle = adoc.TextStyles.Add("simplex")
txtStyle.SetFont "simplex", False, False, 0, 0
'txtStyle.BigFontFile = "fraction" ' keep getting error code 91
' Set the text height - future add to the user form
txtHgt = 0.14
'grab the tablestyle dictionary object
Set oDict = adoc.Database.Dictionaries.Item("acad_tablestyle")
sKeyName = "Block Table"
sClassName = "AcDbTableStyle"
'create the TableStyle object in the dictionary
Set oTblSty = oDict.AddObject(sKeyName, sClassName)
With oTblSty
.Name = "DwgList"
.Description = "Drawing Number and Description"
.HorzCellMargin = 0.15 * txtHgt
.VertCellMargin = 0.15 * txtHgt
.TitleSuppressed = True
.HeaderSuppressed = True
.SetTextHeight 3, txtHgt
.SetGridVisibility 63, AcRowType.acDataRow, False
.SetAlignment 3, acMiddleLeft
.SetTextStyle AcRowType.acDataRow, "simplex"
'aColor.ColorIndex 10
End With
' Create layers Text1 and Text2
Call MakeSetLayer("Text1", 11)
Call MakeSetLayer("Text2", 12)
' See how many rows we need to check
DataSheet.Activate ' Activate the datasheet
With ActiveSheet
RowCount = .Range("A" & .Rows.Count).End(xlUp).row
End With
' Set the table insertion point as 0,0,0
insPt(0) = 0#
insPt(1) = 0#
insPt(2) = 0#
' Turned off when not debugging.
'insPt = adoc.Utility.GetPoint(, vbCrLf & "Pick the upper left point of table:")
' Create the table
Set ListTable = aspace.AddTable(insPt, RowCount, 2, 0.25, 1.5)
ListTable.StyleName = "DwgList"
ListTable.RegenerateTableSuppressed = True ' Hold off creating the actual table
' Supress the title and headers row
ListTable.TitleSuppressed = True ' No title row
ListTable.HeaderSuppressed = True ' No header row
' Copy Excel values to the Acad table
' First column = Drawing Number
' Second column = Drawing Title
' Third column = Contract Flag
' Fourth Column = FRO flag
For iCount = 0 To RowCount - 1
tmpStr1 = CStr(ActiveSheet.Cells(iCount + 1, 1).Value)
' Do we add the "*" or not ?
If FROFlag = "Y" Then
tmpStr1 = "*" + tmpStr1
Else
tmpStr1 = " " + tmpStr1
End If
tmpStrLen1 = MaxVal(Len(tmpStr1), tmpStrLen1)
tmpStr2 = " " + CStr(ActiveSheet.Cells(iCount + 1, 2).Value) ' Add additional buffer character
tmpStrLen2 = MaxVal(Len(tmpStr2), tmpStrLen2)
ContFlag = ActiveSheet.Cells(iCount + 1, 3).Value
FROFlag = ActiveSheet.Cells(iCount + 1, 4).Value
' Change the color of the cell contents
' based on the ContFlag
If ContFlag = "Y" Then
aColor.SetRGB 255, 0, 0 ' ACIIndex = 10
Else ' Not included
aColor.SetRGB 0, 0, 0 ' ACIIndex = 0
End If
' Set the row height
ListTable.RowHeight = 1.5 * txtHgt ' ((0.25 * txtHgt) * 2) + txtHgt
' Load the cells
ListTable.SetText iCount, 0, tmpStr1
ListTable.SetText iCount, 1, tmpStr2
' Set the content color
ListTable.SetCellContentColor iCount, 0, aColor
ListTable.SetCellContentColor iCount, 1, aColor
' Set the alignment
ListTable.SetCellAlignment iCount, 0, acMiddleLeft
ListTable.SetCellAlignment iCount, 1, acMiddleLeft
Next iCount
ListTable.UnmergeCells 0, 0, 0, 1 ' Unmerge the first row
' Set the table column widths based on the maximum string length
ListTable.SetColumnWidth 0, (txtHgt * tmpStrLen1) + (2 * (0.6 * txtHgt)) ' First column
ListTable.SetColumnWidth 1, (txtHgt * tmpStrLen2) + (2 * (0.6 * txtHgt)) ' Second column
ListTable.RegenerateTableSuppressed = False
ListTable.Update
' Maximize the AutoCAD window
'adoc.WindowState = acMax
'acad.Application.ZoomExtents
' Save newly created AutoCAD file
' Source of Public Class Code for the File Dialogs:
' http://forums.autodesk.com/t5/Visual-Basic-Customization/VBA-Open-File-with-Dialog-Box/td-p/1726554/page/2
Dim FilePath As String
Dim FileName As String
Dim objFile As FileDialogs
Dim strFilter As String
Dim strFileName As String
FileName = frmTransmittalData.txtLOTtitle.Value
FilePath = Application.ActiveWorkbook.Path
Set objFile = New FileDialogs
strFilter = "All Files (*.*)|*.*|Drawings (*.dwg)|*.dwg"
objFile.Title = "Save the drawing"
objFile.StartInDir = FilePath
objFile.Filter = strFilter
strFileName = objFile.ShowSave
' Hide the user form
Unload frmTransmittalData
If Not strFileName = vbNullString Then
acad.ActiveDocument.SaveAs strFileName
MsgBox "File saved at :" & vbCrLf & strFileName, vbExclamation
End If
' Need to check if file name already exists?
' Close the AutoCAD session...
acad.Application.Quit ' file was just saved...
' Exit sub
Exit Sub
ErrorHandler:
If Err.Number <> 0 Then
MsgBox Err.Description
Stop
End If
End Sub