'=========================================================
'==            Visual Basic Sample Code From            ==
'==     Microsoft Excel/Visual Basic for Windows 95     ==
'==                  Programmer's Guide                 ==
'==                      Chapter 11                     ==
'=========================================================

' DISCLAIMER OF WARRANTY

' THIS FILE CONTAINS UNDOCUMENTED SAMPLE CODE. THIS SAMPLE CODE IS 
' PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT FURTHER
' DISCLAIMS ALL IMPLIED WARRANTIES INCLUDING WITHOUT LIMITATION ANY
' IMPLIED WARRANTIES OF MERCHANTABILITY OR OF FITNESS FOR A PARTICULAR
' PURPOSE. THE ENTIRE RISK ARISING OUT OF THE USE OR PERFORMANCE OF THE
' SAMPLE CODE REMAINS WITH YOU.

' IN NO EVENT SHALL MICROSOFT OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES
' WHATSOEVER (INCLUDING, WITHOUT LIMITATION, DAMAGES FOR LOSS OF
' BUSINESS PROFITS, BUSINESS INTERRUPTION, LOSS OF BUSINESS INFORMATION,
' OR OTHER PECUNIARY LOSS) ARISING OUT OF THE USE OF OR INABILITY TO USE
' THIS SAMPLE CODE, EVEN IF MICROSOFT HAS BEEN ADVISED OF THE POSSIBILITY
' OF SUCH DAMAGES. BECAUSE SOME STATES DO NOT ALLOW THE EXCLUSION OR
' LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES, THE
' ABOVE LIMITATION MAY NOT APPLY TO YOU.






'=========================================================
'==                    From Page 207                    ==
'=========================================================

Sub Auto_Open()
	MenuBars(xlWorksheet).Menus("Tools").MenuItems.Add _
		caption := "My Analysis", _
		onAction := ThisWorkbook.Name & "!Module2.MyAnalysisProc", _
		before := 1
End Sub





'=========================================================
'==                    From Page 208                    ==
'=========================================================

Sub Auto_Close()
	MenuBars(xlWorksheet).Menus("Tools"). _
		MenuItems("My Analysis").Delete
	CloseLogFile			'Procedure: close transaction file.
	DisconnectService	'Procedure: disconnect info service.
End Sub





'=========================================================
'==                    From Page 211                    ==
'=========================================================

ActiveSheet.Buttons("MyButton").OnAction = "ButtonClickHandler"
Application.OnRepeat text:= "Paste Again", procedure:= "PasteAgain"

'-------------------------------------------------

ActiveSheet.Buttons("MyButton").OnAction = ""
Application.OnRepeat text:= "Paste Again", procedure:= ""





'=========================================================
'==                    From Page 212                    ==
'=========================================================

With DialogSheets(1)
	.DialogFrame.OnAction = "StartDialog"
	.Buttons.OnAction = "ButtonPressed"
End With

'-------------------------------------------------

Sub TrapCalculate()
	Application.OnCalculate = "FitColumns"
End Sub

Sub FitColumns()
	Columns("A:H").EntireColumn.AutoFit
End Sub





'=========================================================
'==                    From Page 213                    ==
'=========================================================

Sub TrapData()						'Set up OnData trapping
	Worksheets("StockAnalysis").OnData = "ValidateData"
End Sub

Sub ValidateData()					'OnData handler
	For Each Cell in InputRange		'InputRange is a public variable
		CheckData					'Run my validation procedure
	Next
End Sub

'-------------------------------------------------

Sub TrapDoubleClick()
	Worksheets("Sheet1").OnDoubleClick = "DoubleClickEvent"
End Sub

Sub DoubleClickEvent()
	MsgBox "Something was double-clicked on Sheet1"
End Sub





'=========================================================
'==                    From Page 214                    ==
'=========================================================

Sub TrapEntry()
	ActiveWorkbook.Worksheets("GeneCountDB").OnEntry = _
		"ValidateColB"
End Sub

Sub ValidateColB()
	With ActiveCell
		If .Column = 2 Then				'Test for second column.
			If IsNumeric(.Value) Then
				If .Value < 0 Or .Value > 255 Then
					MsgBox "Entry must be between 0 and 255."
					.Value = ""
				End If
			Else
				'Handle non-numeric entry
				MsgBox "Entry must be a number between 0 and 255."
				.Value = ""
			End If
		End If
	End With
End Sub





'=========================================================
'==                    From Page 215                    ==
'=========================================================

Sub TrapKeys()							'Trap key combinations.
	Application.OnKey _
		key := "{F12}" , _
		procedure := "DoReports"
End Sub

Sub DoReports()							'F12 OnKey handler.
	AssembleReports
	PrintReports
End Sub





'=========================================================
'==                    From Page 216                    ==
'=========================================================

Sub TrapRepeat()
	Application.OnRepeat _ 
		text:= "Paste Next Day", _ 
		procedure := "PasteIncrement"
End Sub

Sub PasteIncrement()						'OnRepeat handler.
	With ActiveCell
		.Value = .Offset(-1, 0) + 1			'Add a day.
	End With
End Sub





'=========================================================
'==                    From Page 217                    ==
'=========================================================

Sub Auto_Open()
	ThisWorkbook.OnSheetActivate = "WBActivateHandler"
End Sub

Sub WBActivateHandler()
	If ActiveSheet.Name = "My_Data" Then
		Toolbars("EngAnalysisToolbar").Visible = True
	Else
		Toolbars("EngAnalysisToolbar").Visible = False
	End If
End Sub





'=========================================================
'==                    From Page 218                    ==
'=========================================================

'Initialize trapping using OnTime method
Sub TrapTime()
	'Set OnTime arguments
	Application.OnTime _
		earliestTime := TimeValue("12:00:00"), _
		procedure := "DoReports"
End Sub

Sub DoReports()				'OnTime handler
	AssembleReports
	PrintReports
End Sub

'-------------------------------------------------

Sub TrapTime()					'Initialize OnTime trapping.
	Application.OnTime _
		earliestTime := TimeValue("12:00:00"), _
		procedure := "MyOnTimeHandler", _
		latestTime := TimeValue("12:30:00")
End Sub





'=========================================================
'==                    From Page 219                    ==
'=========================================================

Application.OnTime _
	earliestTime := TimeValue("12:00:00"), _
	procedure := "CleanUp", _
	schedule := False

'-------------------------------------------------

'Wait 15 seconds
Application.Wait Now + TimeValue("00:00:15")

'-------------------------------------------------

Application.OnWindow = "AllWindowHandler"

'-------------------------------------------------

Sub TrapBicycle2()
	Windows("BikeDB.XLS:2").OnWindow = "PositionWindow"
End Sub

Sub PositionWindow()
	With Windows("BikeDB.XLS:2")
		.Left = 0
		.Top = 100
		.Width = 300
		.Height = 50
	End With
End Sub


