- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
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
Solved! Go to Solution.