Help with code please
It worked fine for me but I had to add a bit to get at the new menu item
Public Sub Pwd
Dim MyPwd As String
MyPwd = InputBox("Please enter your password (case sensitive)",
"Password required")
If MyPwd < "Michael9855" Then
MsgBox "Sorry thats incorrect", vbCritical, "Invalid password"
Exit Sub
End If
'This code works if l disable the input box!!!!!
Dim mymenu1 As CommandBarControl
Set mymenu1 =
Application.CommandBars(1).Controls("&Michael").Co ntrols.Add(Type:=msoControlButton)
mymenu1.Visible = True
mymenu1.Style = msoButtonCaption
mymenu1.Caption = "Shade Alternate Rows"
mymenu1.OnAction = "Shade_Alternate_Rows"
Application.CommandBars.ActionControl.OnAction = ""
End Sub
--
---
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my addy)
"michael.beckinsale" wrote in message
...
Hi All,
Can anybody tell me whats wrong with this code / why it does not work.
The idea is that administrators will have access to a set of macros
listed in a menu but will not be able to access the menu list without
a password. It works without the input box, but l would like to have
the password entered and then the menu drop down list displayed. All
help gratefully appreciated.
Private Sub Workbook_Open()
Dim michaelsmenu As CommandBarControl
Set michaelsmenu = Application.CommandBars("Worksheet Menu
Bar").Controls.Add(Type:=msoControlPopup, Befo=8)
michaelsmenu.Caption = "&Michael"
michaelsmenu.BeginGroup = False
michaelsmenu.Visible = True
michaelsmenu.OnAction = "Pwd"
Sub Pwd()
Dim MyPwd As String
MyPwd = InputBox("Please enter your password (case sensitive)",
"Password required")
If MyPwd < "Michael9855" Then
MsgBox ("Sorry thats incorrect")
Exit Sub
End If
'This code works if l disable the input box!!!!!
Dim mymenu1 As CommandBarControl
Set mymenu1 = Application.CommandBars("Worksheet Menu
Bar").Controls("&Michael").Controls.Add(Type:=msoC ontrolButton)
mymenu1.Visible = True
mymenu1.Style = msoButtonCaption
mymenu1.Caption = "Shade Alternate Rows"
mymenu1.OnAction = "Shade_Alternate_Rows"
End Sub
Regards
Michael
|