Problem insert table to Autocad from Excel by VBA

[malmal02122023]

Hello,

Could you help me please?

I try to insert the table to AutoCad from Excel but I have a problem with function definition  as shown below
AutoCad2019

Sub GetExcel()
'Excel
Dim wb As excel.workbook
Dim ws As excel.worksheet
Dim text As String
Set wb = GetExcelObject()
Set ws = wb.sheets("CAD")
'CAD
Dim vinsertionpoint As Variant
Dim lnumberofrows As Long
Dim lnumberofcolumns As Long
Dim otable As AcadTable
With ThisDrawing.Utility
vinsertionpoint = .GetPoint(, vbCr & "pick the insertion point: ")
End With
lnumberofrows = 6
lnumberofcolumns = 5
Set otable = ThisDrawing.ModelSpace.AddTable(vinsertionpoint, _
lnumberofrows, lnumberofcolumns, 5, 15)
otable.SetText 0, 0, "Emacro"
'excel -> CAD
text = ws.cells(1, 1)
ThisDrawing.Utility.Prompt (text) + vbNewLine
otable.SetText 1, 0, text

For irow = 1 To lnumberofrow - 1
For icolumn = 0 To lnumberofcolumn - 1
'text = cstr(irow) + "," + cstr(icolumn)
text = ws.cells(irow, icolumn + 1)
otable.SetText irow, icolumn, text
Next
Next
End Sub

Function GetExcelObject() As excel.workbook

Dim wb As excel.workbook
Dim path As String
path = "C:\Users\amali\Downloads\TEST TABLE.xlsx"
Dim ret
ret = isworkbookopen(path)
If ret = True Then
Set wb = VBA.GetObject(path)
ThisDrawing.Utility.Prompt ("excel open") + vbNewLine
Else
Set wb = excel.workboks.Open(path)
ThisDrawing.Utility.Prompt ("excel closed") + vbNewLine
End If
Set getexcelobjet = wb
End Function
Function isworkbookopen(filename As String)
Dim ff As slong, errno As Long
On Error Resume Next
ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
errno = Err
On Error GoTo 0
Select Case errno
Case 0: isworkbookopen = False
Case 70: isworkbookopen = True
Case Else: Error errno
End Select
End Function

Sub GE()
'excel
Dim wb As excel.workbook
Dim ws As excel.worksheet
Dim rg As excel.range
Dim text As String
Set wb = GetExcelObject()
Set ws = wb.sheets("Presupuesto")
'cad
Dim vinsertionpoint As Variant
Dim lnumberofrows As Long
Dim lnumberofcolumns As Long
Dim otable As AcadTable
On Error Resume Next
With ThisDrawing.Utility
vinsertionpoint = .GetPoint(, vbCr & "pick the insertion point: ")
End With
Lnumberorows = 5
lnumberofcolumns = 5
If Err Then Exit Sub
Set otable = ThisDrawing.ModelSpace.adtable(vinsertionpoint, _
Lnumberogrows, lnumberofcolumns, 5, 50)
text = ws.cells(1, 1)
This drawing.Utility.Prompt(text) + vbNewLine
otable.SetText 0, 0, "Presupuesto"
For irow = 1 To lnumberofrows
For icolumn = 1 To 5
Set rg = ws.cells(irow, icolumn)
text = rg.text
otable.SetText irow, icolumn - 1, text
Next
Next
End Sub

Thank you for advice

Best regards
Olek

[Ed__Jobe]

You can't select the WHOLE sheet. It's thousands of columns wide and thousands of rows deep. You need to select a range for the datalink. Select Option 2 if you've created a named range in xl. You also can use the Print Area, which is the default for Option 2. Select Option 3 if you want to manually specify the range. This option is close to what you are trying to do in code. Remember, the whole point of using a DataLink is so that you can specify the area in xl that you want to work with. If you do this here, you don't need to do it in code.