How to open an existing OLE excel worksheet inside the AutoCAD?

[Anonymous]

Hi all,
Previously I have written a small macro so it will read an excel sheet as an indepedent file and compare the excel table contents with text objects found inside the autocad drawing (for double checking purpose). Now when we recently upgrade to AutoCAD 2008, the excel table now become embeded as an OLE object inside the drawing and thus not an independent file. Now I don't know how to make the code to read this excel sheet inside the drawing. It should be something simple but I coudn't find the exact code. Any helps will be welcomed as I am new to VBA. Here is my original subroutine:

Sub readexcel(filename, part_name_2, part_total_2)
Dim Excel As Object
Dim i As Integer
Dim excelSheet As Object
Dim k As Boolean, x As Integer, y As Integer

' Open Excel
On Error Resume Next

Set Excel = GetObject(, "Excel.Application")

If Err <> 0 Then
Err.Clear
Set Excel = CreateObject("Excel.Application")

If Err <> 0 Then
MsgBox "Could not load Excel.", vbExclamation
End
End If
End If

On Error GoTo 0

If Dir(filename) = "" Then
MsgBox ("Error: Can not find Excel " & filename & " file.")
End
End If

Excel.Visible = True
Excel.Workbooks.Open (filename)
Excel.Sheets(1).Select
Set excelSheet = Excel.ActiveWorkbook.Sheets(1)

x = 1
part_total_2 = 0

Do While x < 16
k = False
For y = 1 To 37
excelSheet.Cells(y, x).Select
If Trim(excelSheet.Cells(y, x)) = "PARTS NO." Then k = True
If k = True Then
If Excel.ActiveCell.Interior.ColorIndex = -4142 And _
LTrim(excelSheet.Cells(y, x)) <> "" And _
Left(excelSheet.Cells(y, x), 1) <> "(" And _
Left(excelSheet.Cells(y, x), 2) <> "GK" And _
Left(excelSheet.Cells(y, x), 3) <> "SPG" And _
Left(excelSheet.Cells(y, x), 2) <> "B_" Then
part_total_2 = part_total_2 + 1
part_name_2(part_total_2) = CStr(excelSheet.Cells(y, x))
End If
End If
Next y
If k = True Then x = x + 3 Else x = x + 1
k = False
Loop
Excel.ActiveWorkbook.Close SaveChanges:=False
Excel.Quit
End Sub

Thanks,
Joseph

[Anonymous]

Here is the drawing with excel chart embeded inside that illustrate this situation. Still need any help I can get.
Joseph

[Anonymous]

This is the best I can come up with, short of simulating a double click. The open or activate feature does not seem to be exposed.

Sub TestItOut()
Dim testEnt As AcadEntity, pkPnt As Variant
ThisDrawing.Utility.GetEntity testEnt, pkPnt
If testEnt.ObjectName = "AcDbOle2Frame" Then _
openOle (testEnt.Handle)
End Sub

Sub openOle(entHandle As String)
Dim qM As String
qM = """"
ThisDrawing.SendCommand _
"(command " & qM & "SELECT" & qM & ") " & _
"(handent " & qM & entHandle & qM & ") " & _
"(command " & qM & "OLEOPEN" & qM & ") "
DoEvents
End Sub

[Anonymous]

joyride wrote:
> Here is the drawing with excel chart embeded inside that illustrate this situation. Still need any help I can get.
> Joseph

I don't have '08 but I thought there was now commands to import an Excel
range into an AutoCAD table & keep a link?

I hope there is because that is the main reason I want to upgrade.

Cheers
Dave F.

[Anonymous]

Thank you for your assistance, Rstrandmark. As you know I am not that familliar with VBA object programing. How do I use your subroutine inside my original code? If I insert it inplace of Excel.Workbooks.Open (filename) command, it will ask me to select object, and than display Run-time Error, Method 'GetEntity' of object 'IAcadUtility' failed. What I did wrong? Does it mean the user need to manually click the OLE excel table?
Joseph

[Anonymous]

Dave,
Yes, I think you can maintain excel link inside the autocad table in 2008. We just copy an excel table and pasted inside the autocad as it is easier or more familiar to edit them using excel when double clicking the table. Furthermore, these drawings have already been done this way, and I just try to fix my self-checking macro so it will work again.
Joseph

[Anonymous]

I can help, but I do not understand this line:
part_name_2(part_total_2) = CStr(excelSheet.Cells(y, x))

I don't necessarily understand what the code accomplishes as this may be just part of some other code? It appears you either are trying to multply a text string which causes an error or you are trying to assign a value to a dimension of an array to the string "part_name_2" which is not an array so it will cause an error.

Other then that, here is code that will get it to that line but it errors. You have to go into "tools" menu in the VBA editor, and set a reference to the "Microsoft Excel xx.0 Object Library". I removed some code that wasn't necessary and changed some also. Put all this code into a module. I was unsure how you were calling this code so I created a sub called "testRdXL" to execute it. I noticed that the forums remove double spaces so I rewrote part of the subroutine I wrote earlier (openOLE). The following code assumes that you do NOT have any excel applications open. It opens the OLE object, finds it, and sets the active workbook to the variables below. If there are other excel workbooks open, it may assign that to the variable and obviously the sub will fail miserably then. This code also assumes that there is only 1 excel OLE object embedded in the dwg file.

Sub testRdXL()
readexcel "M1001-01", "1"
End Sub

Sub readexcel(part_name_2, part_total_2)
Dim xlApp As Excel.Application
Dim i As Integer
Dim excelSheet As Excel.Worksheet
Dim k As Boolean, x As Integer, y As Integer
Dim ent As AcadEntity
For Each ent In ThisDrawing.ModelSpace
If ent.ObjectName = "AcDbOle2Frame" Then
If ent.OleSourceApp = "Microsoft Office Excel Worksheet" Then
openOle (ent.Handle)
Else
GoTo noFind
End If
Else
End If
Next ent
' Open Excel
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
MsgBox "Could find an open Excel instance.", vbExclamation
End
End If
On Error GoTo 0
Set excelSheet = xlApp.ActiveWorkbook.ActiveSheet
x = 1
part_total_2 = 0
Do While x < 16
k = False
For y = 1 To 37
excelSheet.Cells(y, x).Select
If Trim(excelSheet.Cells(y, x)) = "PARTS NO." Then k = True
If k = True Then
If xlApp.ActiveCell.Interior.ColorIndex = -4142 And _
LTrim(excelSheet.Cells(y, x)) <> "" And _
Left(excelSheet.Cells(y, x), 1) <> "(" And _
Left(excelSheet.Cells(y, x), 2) <> "GK" And _
Left(excelSheet.Cells(y, x), 3) <> "SPG" And _
Left(excelSheet.Cells(y, x), 2) <> "B_" Then
part_total_2 = part_total_2 + 1
part_name_2(part_total_2) = CStr(excelSheet.Cells(y, x))
End If
End If
Next y
If k = True Then x = x + 3 Else x = x + 1
k = False
Loop
xlApp.ActiveWorkbook.Close SaveChanges:=False
xlApp.Quit
Exit Sub
noFind:
MsgBox "Couldn't find the OLE object to open"
End Sub

Sub openOle(entHandle As String)
Dim qM As String
qM = """"
ThisDrawing.SendCommand _
"(command " & qM & "SELECT" & qM & ") " & _
"(handent " & qM & entHandle & qM & ") " & " " & _
"(command " & qM & "OLEOPEN" & qM & ") "
DoEvents
End Sub Message was edited by: rstrandmark

[Anonymous]

Thank you so much for your assistance, Rstrandmark. I am very grateful for your time spent. I got it work with a slight modification with ent.OleSourceApp statement:
If ent.OleSourceApp Like "*Excel" then .....
This is because I found out the Excel 97 this object gives "Microsoft Office Excel Worksheet" and Excel 2003 gives "Microsoft Excel Worksheet" instead. I also found the excel library it use is also different (8.0 vs 11.0). Furthemore, I found out this code only works in AutoCAD 2008, but not in AutoCAD 2002 as "ent.OleSourceApp" or GetObject(, "Excel.Application") returns nothing in AutoCAD 2002. But since the main user of this macro run 2008, this is not a major issue.
Answering your question, yes, part_name2 was dimensioned in the main program, and I have recorded the data as a string array so it can be compare with the string read from the drawing. The main purpose of the program is to double check the items labeled in the drawings with the excel chart BOM to minimize the keying error.
Again, thank you. You are a life saver.
Joseph