View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Dean[_6_] Dean[_6_] is offline
external usenet poster
 
Posts: 5
Default 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