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

' 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 141                    ==
'=========================================================

MsgBox prompt:="Please close all files", title:="Files"





'=========================================================
'==                    From Page 142                    ==
'=========================================================

Sub CreateSampleBox()
	msg = "Do you want to continue?"
	dialogStyle = vbYesNo + vbExclamation + vbDefaultButton2
	title = "Error"
	response = MsgBox(msg, dialogStyle, title)	' Get user response.
	If response = vbYes Then						' Evaluate response and
		msg = "You clicked Yes."					' act appropriately
	Else	
		msg = "You clicked No or pressed ENTER."
	End If
	MsgBox msg									' Display action taken.
End Sub

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

radius = InputBox("Enter the circle's radius:", "Circle Radius")





'=========================================================
'==                    From Page 143                    ==
'=========================================================

Sub CountValues()
	cellCount = 0
	Set rangeToSearch = Application.InputBox( _
		Prompt:="Enter the range to search", _
		Type:=8)		'type 8: must be a Range object
	searchValue = Application.InputBox( _
		Prompt:="Enter the search value", _
		Type:=1)		' type 1: must be a number
	If searchValue = False Then Exit Sub		'user clicked Cancel
	For Each c In rangeToSearch
		If c.Value = searchValue Then
			cellCount = cellCount + 1
		End If
	Next c
	MsgBox cellCount
End Sub





'=========================================================
'==                    From Page 144                    ==
'=========================================================

Application.Dialogs(xlDialogOpen).Show("C:\XLFILES")

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

Sub NewWorkbook()
	If Application.Dialogs(xlDialogOpen).Show("c:\") And _
		ActiveWindow.Type = xlWorkbook Then ProcessWorkbook
End Sub





'=========================================================
'==                    From Page 147                    ==
'=========================================================

Worksheets("sheet1").Buttons.Add 50, 25, 100, 20





'=========================================================
'==                    From Page 150                    ==
'=========================================================

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




'=========================================================
'==                    From Page 152                    ==
'=========================================================

Worksheets("sheet1").CheckBoxes("Check Box 3").LinkedCell = "sheet1!a5"

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

Worksheets("sheet1").ListBoxes("List Box 2"). _
	ListFillRange = "sheet1!a5:a10"





'=========================================================
'==                    From Page 158                    ==
'=========================================================

Sub DoColorDialog()
	colors(1) = 5   'blue
	colors(2) = 10  'green
	colors(3) = 6   'yellow
	colors(4) = 22  'orange
	originalColor = Selection.Interior.ColorIndex
	saveInteriorColor = originalColor
	If DialogSheets("ChangeColorDialog").Show = False Then
		Selection.Interior.ColorIndex = originalColor
	End If
End Sub





'=========================================================
'==                    From Page 159                    ==
'=========================================================

Sub ChangeColor()
	Dim selInterior As Interior
	With DialogSheets("ChangeColorDialog")
		Set selInterior = Selection.Interior
		saveInteriorColor = selInterior.ColorIndex
		selInterior.ColorIndex = colors(GetOptionIndex(.OptionButtons))
	End With
End Sub

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

Function GetOptionIndex(opBtns As OptionButtons)
	For Each ob In opBtns
		If ob.Value = xlOn Then
			GetOptionIndex = ob.Index
			Exit Function
		End If
	Next
End Function

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

Sub UndoColor()
	With Selection.Interior
		temp = .ColorIndex
		.ColorIndex = saveInteriorColor
		saveInteriorColor = temp
	End With
End Sub





'=========================================================
'==                    From Page 160                    ==
'=========================================================

Sub SetOptions()
	With ActiveDialog
		If .CheckBoxes(1).Value = xlOn Then
			.OptionButtons(Array(1, 2, 3, 4)).Enabled = True
		Else
			With .OptionButtons(Array(1, 2, 3, 4))
				.Enabled = False
				.Value = xlOff
			End With
		End If
	End With
End Sub

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

Sub SetFocus()
	ActiveDialog.Focus = "test"
End Sub





'=========================================================
'==                    From Page 161                    ==
'=========================================================

Sub DisplayOptions()
	ActiveDialog.DialogFrame.Height = 91
End Sub

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

Sub HideDialog()
	If MsgBox("Remove dialog box?", vbYesNo) = vbYes Then
		ActiveDialog.Hide
	End If
End Sub


