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

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

MenuBars.Add "myWorksheetMenubar"





'=========================================================
'==                    From Page 172                    ==
'=========================================================

MenuBars(xlWorksheet4).Activate





'=========================================================
'==                    From Page 173                    ==
'=========================================================

Set newMenu = MenuBars(xlChart).Menus.Add( _
	Caption:="&MyWorkMenu", _
	before:="Help")





'=========================================================
'==                    From Page 174                    ==
'=========================================================

Set databaseItem = MenuBars(xlWorksheet).Menus("File") _
	.MenuItems.Add(Caption:="Open &Database", _
		OnAction:="OpenDatabaseProc", _
		before:="Close")

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

MenuBars(xlWorksheet).Menus("File").MenuItems.Add _
	Caption:="-", before:="Close"

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

ShortcutMenus(xlWorksheetCell).MenuItems.Add _
	Caption:="Format &Special", OnAction:="FormatSpecialProc"





'=========================================================
'==                    From Page 176                    ==
'=========================================================

MenuBars(xlModule).Menus.Add "myMenu"

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

MenuBars(xlModule).Menus("myMenu").MenuItems.AddMenu "mySM"

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

MenuBars(xlModule).Menus("myMenu").MenuItems("mySM") _
	.MenuItems.Add "mySMItem"

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

MenuBars(xlModule).Menus("myMenu").MenuItems("mySM") _
	.MenuItems("mySMItem").Checked = True

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

MenuBars(xlModule).Menus.Add("myMenu").MenuItems.AddMenu("mySM") _
	.MenuItems.Add("mySMItem").Checked = True




'=========================================================
'==                    From Page 177                    ==
'=========================================================

Sub AddNewMenu()
	Set sortMenu = MenuBars(xlWorksheet).Menus.Add("&Sort By")
	With sortMenu.MenuItems
		.Add "Company Name", "SortByCompany"
		.Add "Category ID", "SortByCategory"
		.Add "Type", "SortByType"
		.Add ("-")
		.Add "Random", "SetRandomOrder"
		Set sortSubMenu = sortMenu.MenuItems _
				.AddMenu("Cost", before:="-")
			sortSubMenu.MenuItems.Add "Ascending", "SortByCostAscending"
			sortSubMenu.MenuItems.Add "Descending", _
				"SortByCostDescending"
	End With
End Sub




'=========================================================
'==                    From Page 178                    ==
'=========================================================

MenuBars("myWorksheetMenubar").Delete

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

MenuBars(xlChart).Menus("Edit").Delete

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

ShortcutMenus(xlDrawingObject).MenuItems("Group").Delete





'=========================================================
'==                    From Page 179                    ==
'=========================================================

MenuBars(xlWorksheet).Reset





'=========================================================
'==                    From Page 180                    ==
'=========================================================

MenuBars(xlChart).Menus.Add caption:="Edit", _
	before:="View", restore:=True

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

MenuBars(xlWorksheet).Menus("File").MenuItems.Add _
	caption := "Open...", _
	restore := True, _
	before := "Close"

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

MenuBars(xlModule).Menus("Tools").MenuItems.AddMenu _
	caption := "Protection", _
	restore := True, _
	before := "Add-Ins..."





'=========================================================
'==                    From Page 181                    ==
'=========================================================

With Worksheets("data108")
	.OnSheetActivate = "AddNewMenu"
	.OnSheetDeactivate = "RemoveNewMenu"
End With





'=========================================================
'==                    From Page 182                    ==
'=========================================================

MenuBars(xlWorksheet).Menus("File") _
	.MenuItems.Add("Open Database").Enabled = False

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

MenuBars(xlWorksheet).Menus("File").Enabled = False

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

With MenuBars(xlWorksheet).Menus("sort by").MenuItems("cost")
	For Each mnItem In .MenuItems
		mnItem.Enabled = False
	Next
End With

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

ShortcutMenus(xlWorksheetCell).MenuItems(0).Enabled = False





'=========================================================
'==                    From Page 183                    ==
'=========================================================

Sub DatabaseView()
	With MenuBars(xlWorksheet).Menus("View").MenuItems("Database")
	.Checked = Not .Checked
	If .Checked Then
			'Switch to database view
		Else
			'Switch to worksheet view
		End If
	End With
End Sub

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

MenuBars("MyMenubar").Menus("File").MenuItems("Open Database") _
	.Caption = "Close &Database"

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

Set myMenu = MenuBars("My Menubar").Menus _
	("File").MenuItems("Open Database")

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

myMenu.Caption = "Close &Database"





'=========================================================
'==                    From Page 188                    ==
'=========================================================

Sub ViewMyAppToolbar()
	With MenuBars(xlWorksheet).Menus("View").MenuItems("View MyToolbar")
		.Checked = Not .Checked
		Toolbars("MyAppTools").Visible = .Checked
	End With
End Sub





'=========================================================
'==                    From Page 189                    ==
'=========================================================

For Each thisToolbar In Toolbars
	If thisToolbar.BuiltIn Then
		thisToolbar.Reset
	Else
		thisToolbar.Delete
	End If
Next





'=========================================================
'==                    From Page 190                    ==
'=========================================================

With Toolbars("MyAppTools").ToolbarButtons

	' Add a button with the clock face
	Set newButton1 = .Add( _
		Button:=213, _
		before:=1, _
		OnAction:="Module1.MyScheduler", _
		Enabled:=True, _
		Pushed:=False, _
		StatusBar:="Run custom scheduler")	' sets status bar text
	newButton1.Name = "Scheduler"			' sets tool tip text

	' Add a button with the scissors face
	Set newButton2 = .Add( _
		Button:=12, _
		before:=2, _
		OnAction:="Module1.MyCutProc", _
		Enabled:=True, _
		Pushed:=False, _
		StatusBar:="Custom cut command")		' sets status bar text
	newButton2.Name = "Custom Cut"			' sets tool tip text

	' Add a space between the buttons
	.Add Button:=0, before:=2
End With

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

Toolbars("Standard").ToolbarButtons(3).Delete





'=========================================================
'==                    From Page 191                    ==
'=========================================================

Toolbars("Standard").ToolbarButtons(3).Enabled = False

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

Sub DatabaseView()
	With Toolbars("MyAppToolbar").ToolbarButtons(3)
		.Pushed = Not .Pushed
		If .Pushed Then
			'Switch to database view
		Else
			'Switch to worksheet view
		End If
	End With
End Sub

