PDA

View Full Version : Desperately seeking Closure



T_Livingston
2004-11-10, 03:34 PM
The following is dealing with Active X and Excel. I know of only this forum for answers.

My Problem (today) :

I am sending Sketch numbers to Excel to be sorted and then Print the new sorted list.
I can open Excel and plug in my data just fine.

My problem occurs when I try to close the Instance of Excel I just opened. It won't.
I am doing the Ctrl+Alt+Delete and then Task Manager. Under "Processes" is where I can see my Excel.exe start up, do all the massaging, and then it just sits there......mocking me. I can seem to close it.

When I run the macro again...It finds the Instance open from the first try, does its thing. But still won't close. What Gives ??

ANY tips are appreciated
Thank you

Tim Livingston
Acad 2004 vb6

The following code is just a fragment but the Excel code is still here

Option Explicit

Public Sub CoilateTickets()

Dim MyExcel As Excel.Application
Dim MyExcelSheet As Excel.Worksheet
Dim MySS As AcadSelectionSet
Dim GrpC(0 To 1) As Integer
Dim GrpV(0 To 1) As Variant

GrpC(0) = 0: GrpV(0) = "Insert"
GrpC(1) = 2: GrpV(1) = "SPI-Tick*"

Set MySS = ThisDrawing.SelectionSets.Add("SKNumbers95")
MySS.Select acSelectionSetAll, , , GrpC, GrpV
'--------------------------------------------------------
'Go get Excel and open the worksheet
On Error Resume Next
Set MyExcel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set MyExcel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could Not Load Excel!", vbExclamation
End
End If
End If
On Error GoTo 0
MyExcel.Workbooks.Add ("I:\CADD\TIM\Auto-Excel Files\SkNumberer.xls")
MyExcel.Visible = True
MyExcel.Sheets("Sheet1").Select
Set MyExcelSheet = MyExcel.ActiveWorkbook.Sheets("Sheet1")
'------------------------------------------------------------------------------
'Populate the worksheet
'------------------------------------------------------------------------------------------
'Sort the column
'------------------------------------------------------------------------------------------
'Print the tickets
'------------------------------------------------------------------------------------------
' Close up Shop
MySS.Delete
MyExcel.DisplayAlerts = False
MyExcel.ActiveWindow.Close False
MyExcel.DisplayAlerts = True
MyExcel.Quit
If Not MyExcel Is Nothing Then
Set MyExcelSheet = Nothing
Set MyExcel = Nothing
End If
End Sub

Ed Jobe
2004-11-10, 04:11 PM
It's your 'Close up shop' code. With most object variables, they get reset to Nothing when they go out of scope. But Excel is notorious for leaving objects hang. You have to explicitly set them to Nothing, note, in reverse creation order. For example, you can't create a workbook object until you create an app object. Therefore, you have to reset the workbook first, then the app. Also, be careful because some operations create objects, e.g. a range object. You may not directly create them but you have to handle clearing them. So in your code, you clear the app object first and then do an IF check. That will always cause this problem. Just replace that with a series of Set statements. Set all objs, to Nothing and eliminate the IF.

T_Livingston
2004-11-10, 05:42 PM
Ed - Thank you for the advise

My new close up shop portion
now looks like this :

' Close up Shop
MySS.Delete
MyExcel.DisplayAlerts = False
MyExcel.ActiveWindow.Close False
MyExcel.DisplayAlerts = True
MyExcel.Quit
Set MyExcel = Nothing
Set MyExcelSheet = Nothing

BUT, Excel is still open
Does my new code match what you meant ?

Thanks again
Tim Livingston

Ed Jobe
2004-11-10, 06:30 PM
No, check the last to Set statements. You can't close xl if a sheet is still resident in memory. Reverse the two lines. Also, wheres the workbook obj? Think of a parent-child relationship. The sheet is part of a workbook, which is part of an app. You can have an app with no workbook, but not the other way around. So if the workbook is still open, the app has to be open.

T_Livingston
2004-11-10, 07:58 PM
Thanks again Ed -

Unfortunatlly I still can't get it to Close.

Below is the code as of now...
Again Thank you.





Option Explicit

Public Sub CoilateTickets()

Dim MyExcel As Excel.Application
Dim MyExcelWorkbook As Excel.Workbook ' added the workbook object
Dim MyExcelSheet As Excel.Worksheet
Dim MySS As AcadSelectionSet
Dim GrpC(0 To 1) As Integer
Dim GrpV(0 To 1) As Variant

GrpC(0) = 0: GrpV(0) = "Insert"
GrpC(1) = 2: GrpV(1) = "SPI-Tick*"

Set MySS = ThisDrawing.SelectionSets.Add("SKNumbers100")
MySS.Select acSelectionSetAll, , , GrpC, GrpV
'--------------------------------------------------------
'Go get Excel and open the worksheet
On Error Resume Next
Set MyExcel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set MyExcel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could Not Load Excel!", vbExclamation
End
End If
End If
On Error GoTo 0
'-----------------------------------------------------------------------------------------------------------------
' I have added the workbook object here
Set MyExcelWorkbook = MyExcel.Workbooks.Add("I:\CADD\TIM\Auto-Excel Files\SkNumberer.xls")
MyExcel.Visible = True
MyExcel.Sheets("Sheet1").Select
Set MyExcelSheet = MyExcel.ActiveWorkbook.Sheets("sheet1")
'------------------------------------------------------------------------------
'Populate the worksheet
'------------------------------------------------------------------------------------------
'Sort the column
'------------------------------------------------------------------------------------------
'Print the tickets
'------------------------------------------------------------------------------------------
' Close up Shop
MySS.Delete
MyExcel.DisplayAlerts = False
MyExcel.ActiveWindow.Close False
MyExcel.DisplayAlerts = True
MyExcel.Quit

Set MyExcelSheet = Nothing
Set MyExcelWorkbook = Nothing
Set MyExcel = Nothing


End Sub

Ed Jobe
2004-11-10, 08:46 PM
I can't see all you code for what's going on in xl, but you must be creating other objects somewhere else, e.g 'sort the colum'. You've shown me a sheet obj, but I don't see what other code you have that might be working with children of the sheet obj. You have to clear ALL xl objects you create, not just the upper levels. Examine your code for other objects that could still be in memory.

T_Livingston
2004-11-10, 09:03 PM
Well, Ed,

Looks like I have no other choice....
Here is the whole thing. I hate to keep up with this but I would rather not say how long I have been trying to get this thing going and Insiration has given way to desperation.

FYI, I really hope this isn't the problem but I sometimes get an error when I am trying to "Sort the Column"

Option Explicit

Public Sub CoilateTickets()

Dim MyExcel As Excel.Application
Dim MyExcelWorkbook As Excel.Workbook
Dim MyExcelSheet As Worksheet
Dim MySS As AcadSelectionSet
Dim GrpC(0 To 1) As Integer
Dim GrpV(0 To 1) As Variant

GrpC(0) = 0: GrpV(0) = "Insert"
GrpC(1) = 2: GrpV(1) = "SPI-Tick*"

Set MySS = ThisDrawing.SelectionSets.Add("SKNumbers102")
MySS.Select acSelectionSetAll, , , GrpC, GrpV
'--------------------------------------------------------
'Go get Excel and open the worksheet
On Error Resume Next
Set MyExcel = GetObject(, "Excel.Application")
If Err <> 0 Then
Err.Clear
Set MyExcel = CreateObject("Excel.Application")
If Err <> 0 Then
MsgBox "Could Not Load Excel!", vbExclamation
End
End If
End If
On Error GoTo 0
Set MyExcelWorkbook = MyExcel.Workbooks.Add("I:\CADD\TIM\Auto-Excel Files\SkNumberer.xls")
MyExcel.Visible = True
MyExcel.sheets("Sheet1").Select
Set MyExcelSheet = MyExcel.ActiveWorkbook.sheets("sheet1")
'------------------------------------------------------------------------------
'Populate the worksheet
Dim RowNum As Integer
Dim Atts As Variant
Dim SkNumber As String
Dim entity As AcadEntity
RowNum = 1
For Each entity In MySS
Atts = entity.GetAttributes
SkNumber = Atts(0).TextString
MyExcelSheet.Cells(RowNum, "A").Value = SkNumber
RowNum = RowNum + 1
Next
'------------------------------------------------------------------------------------------
'Sort the column
Cells.Select
Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("D1").Select
'------------------------------------------------------------------------------------------
'Print the tickets
Dim i As Integer
Dim J As Integer
Dim CADEnt As AcadEntity
For i = 1 To 1000
If MyExcelSheet.Cells(i, "A").Value = "" Or MyExcelSheet.Cells(i, "A").Value = "zzzzzz" Then
Exit For
Else
For Each CADEnt In MySS
Atts = CADEnt.GetAttributes
If MyExcelSheet.Cells(i, "A").Value = Atts(0).TextString Then
Dim point1 As Variant
Dim point2(0 To 1) As Double
Dim Count As Variant
Dim SelPt As Variant
Dim SelEnt As AcadBlockReference
Dim temp As Variant
point1 = CADEnt.InsertionPoint
ReDim Preserve point1(0 To 1)
For Count = LBound(point1) To UBound(point1)
point2(Count) = point1(Count)
Next Count
point2(0) = point2(0) + 229.22338
point2(1) = point2(1) + 182.5046
ThisDrawing.ActiveLayout.SetWindowToPlot point1, point2
ThisDrawing.ActiveLayout.GetWindowToPlot point1, point2
ThisDrawing.ActiveLayout.PlotType = acWindow
'ThisDrawing.Plot.PlotToDevice
Exit For
End If
Next
End If
Next i
'------------------------------------------------------------------------------------------
' Close up Shop
MySS.Delete
MyExcel.DisplayAlerts = False
MyExcel.ActiveWorkbook.Close False
MyExcel.DisplayAlerts = True
MyExcel.Quit

Set MyExcelSheet = Nothing
Set MyExcelWorkbook = Nothing
Set MyExcel = Nothing


End Sub

Ed Jobe
2004-11-10, 09:50 PM
Before I look this over, do me a favor. Perform Tools>Debug and let me know if you have any compile errors.

T_Livingston
2004-11-10, 09:56 PM
I don't have that option on my menu ( Acad 2004 ) vb editor.

Although I have been using F8 to step through it. Which works fine.

Tim Livingston

Ed Jobe
2004-11-10, 10:18 PM
I'm sorry for that brain fog, that should have been Debug>Compile.

T_Livingston
2004-11-10, 10:22 PM
I show it as "Greyed out" ......??

cll
2004-11-11, 07:57 AM
Hi,

have had the same problem - look at the thread: Excel connection.

I foud that putting an End before leaving the code solved the problem - it gives an "Execution error" in AutoCad, but gives me no troubles.

Best regards
Claus

T_Livingston
2004-11-11, 02:37 PM
Well -
It worked ? I am dumbfounded but it got the cow out of the ditch !!

Thank you Claus and Ed very much.

Tim Livingston

Ed Jobe
2004-11-12, 04:27 PM
While it may work, that's like blowing up the vehicle to get it to stop because you didn't know where the brake pedal was. I still recommend that you find out what object is staying resident in memory and terminate it properly.

Tim, it's grayed out because the dvb is already compiled, which answers my question. I just wanted to make sure that you didn't have any variables that weren't declared. Doing a compile would catch this if you have set Option Explicit.

But, as I mentioned before seeing your code, be careful of using methods that return objects. For example, although you're using Cells as if it were a fuction, its actually a method of the Doc object and it returns a Range object. You should explicitly declare a Range variable to hold this returned object, then you can clear it in your clean up section.

That is one example, check for others.

Also, I was helping you with this without mentioning other possibilities just so you could learn how to solve this problem, but it is not necessary to use xl just for sorting. There are several options. VBA has some objects like dictionaries that can sort. You can also apply common sorting algorithims. Here is a function I wrote that applies a bubble sorting algorithm to a single dimension array. This algorithm is fine for reasonable amounts of data but is slow for large amounts. The idea of a bubble sort is that items "bubble" up to the top of their order. Follow the function's logic and you'll see what I mean.



Public Function BubbleSort(TempArray As Variant, Optional Asc As Boolean = True)
'Performs an ascending sort on an array
Dim temp As Variant
Dim i As Integer
Dim NoExchanges As Boolean

' Loop until no more "exchanges" are made.
Do
NoExchanges = True

' Loop through each element in the array.
For i = 0 To UBound(TempArray) - 1

If Asc = True Then
' Sort Ascending [default]
' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) > TempArray(i + 1) Then
NoExchanges = False
temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = temp
End If
Else
' Sort Descending
' If the element is less than the element
' following it, exchange the two elements.
If TempArray(i) < TempArray(i + 1) Then
NoExchanges = False
temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = temp
End If
End If
Next i
Loop While Not NoExchanges

End Function