Excel 2003 and Application.Quit
I know there is a bug in Excel 2003 regarding smart
documents and applications.quit. However, I do not have
any smart documents, that I am aware of, and when the
application.quit is executed, excel stays open. Here is
my code.....
Sub Workbook_BeforeClose(Cancel As Boolean)
' Restore Toolbars And Return To Normal Screen
Application.DisplayFormulaBar = True
For i = 1 To Application.Toolbars.Count
Application.Toolbars(i).Visible = CurrentToolSet(i)
Next i
'Close Workbook and Do Not Save Changes Without Prompt
If LCase(Application.UserName) < "x" And LCase
(Application.UserName) < "y" Then
ThisWorkbook.Close SaveChanges:=False
End If
End Sub
Sub Workbook_Open()
' Emmulate Full Screen By Turning Off Active Toolbars
Application.WindowState = xlMaximized
Application.DisplayFormulaBar = False
For i = 1 To Application.Toolbars.Count
CurrentToolSet(i) = Application.Toolbars(i).Visible
Application.Toolbars(i).Visible = False
Next i
' Capture Today's Date For Auto Refresh Determination
Dim d_Today
Dim d_LstUpdt
d_Today = Date
d_LstUpdt = Worksheets("Parameters").Range("Q12").Value
' Set AutoCalc Off Due To Conflict With SAPBEX Query
Refresh Or Data Duplication
Application.Calculation = xlManual
' Detemine If Auto Refresh Should Be Executed
If (d_Today < d_LstUpdt) Then
If LCase(Application.UserName) = "x" Or LCase
(Application.UserName) = "y" Then
' Copy External Goals Data Into Corresponding
Worksheet
CopySheetValues "ChW Goal Sharing Goals
Data.xls", "Close", "Goals Qry", "Goals_Qry", "Goals
Data", 2
' Copy External Profit Centers & Cost Centers Data
Into Corresponding Worksheet
CopySheetValues "ChW Goal Sharing SAP BW
Data.xls", "", "Parameters", "Parameters", "Parameters", 0
' Copy External Finished Goods Output Data Into
Corresponding Worksheet
CopySheetValues "ChW Goal Sharing SAP BW
Data.xls", "", "FG Qry", "FG_Qry", "FG Data", 2
' Copy External Destructive Testing Data Into
Corresponding Worksheet
CopySheetValues "ChW Goal Sharing SAP BW
Data.xls", "", "IndMat Qry", "IndMat_Qry", "IndMat Data", 3
' Copy External Scrap/Inventory Adjustments Data Into
Corresponding Worksheet
CopySheetValues "ChW Goal Sharing SAP BW
Data.xls", "", "Scrap Qry", "Scrap_Qry", "Scrap Data", 3
' Copy External Inventory Adjustment Data Into
Corresponding Worksheet
CopySheetValues "ChW Goal Sharing SAP BW
Data.xls", "", "InvAdj Qry", "InvAdj_Qry", "InvAdj Data", 2
' Copy External Destructive Testing Data Into
Corresponding Worksheet
CopySheetValues "ChW Goal Sharing SAP BW
Data.xls", "Close", "DstTst Qry", "DstTst_Qry", "DstTst
Data", 4
' Copy External Equivalent Unit Output Data Into
Corresponding Worksheet
CopySheetValues "ChW Goal Sharing EU & FO
Data.xls", "Close", "EU FO Qry", "EU_FO_Qry", "EU FO
Data", 2
' Copy External Scrap Adjustment Data Into
Corresponding Worksheet
CopySheetValues "ChW Goal Sharing ScrAdj
Data.xls", "Close", "ScrAdj Qry", "ScrAdj_Qry", "ScrAdj
Data", 3
' Copy External Labor Data Into Corresponding
Worksheet
CopySheetValues "ChW Goal Sharing Labor
Data.xls", "Close", "Labor Qry", "Labor_Qry", "Labor
Data", 3
' Copy External Rework Data Into Corresponding
Worksheet
CopySheetValues "ChW Goal Sharing Rework
Data.xls", "Close", "Rework Qry", "Rework_Qry", "Rework
Data", 3
' Copy External QCS Zero Mileage Data Into
Corresponding Worksheet
CopySheetValues "ChW Goal Sharing QCS
Data.xls", "Close", "QCS0M Qry", "QCS0M_Qry", "QCS0M
Data", 4
' Filter Out Duplicate Profit Centers In Column A/B
and Copy Unique List to Column G/H
Worksheets("Parameters").Range("G13:H65000").Clear
Range("ProfitCenters").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Worksheets
("Parameters").Range("G13"), Unique:=True
' Filter Out Duplicate Cost Centers In Column C/D and
Copy Unique List to Column I/J
Worksheets("Parameters").Range("I13:J65000").Clear
Range("CostCenters").AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Worksheets
("Parameters").Range("I13"), Unique:=True
' Capture Date For Last Updated
Worksheets("Parameters").Range("Q12").Value =
d_Today
' Reset AutoCalc On Due To Conflict With SAPBEX Query
Refresh Or Data Duplication
Application.Calculation = xlAutomatic
' Set Profit Center and Cost Center Drop Down Indices
To Plant Default
Worksheets("DropDowns").Range("B1").Value = 1
Worksheets("DropDowns").Range("H1").Value = 1
' Activate Status Worksheet
Worksheets("Status").Activate
' Exit Spreadsheet
ThisWorkbook.Close SaveChanges:=True
Application.Quit
End If
End If
' Set Profit Center and Cost Center Drop Down Indices To
Plant Default
Worksheets("DropDowns").Range("B1").Value = 1
Worksheets("DropDowns").Range("H1").Value = 1
' Activate Status Worksheet
Worksheets("Status").Activate
' Reset AutoCalc On Due To Conflict With SAPBEX Query
Refresh Or Data Duplication
Application.Calculation = xlAutomatic
End Sub
|