MenuBar properties


J

Jim Evans

I have a custom Menu that I want to use for a customer's Access application
but I want to allow users to see portions of the menu, based on Loggedin
Username. I have the Username but I cannot find any information about
setting a particular menu choice to visible or not.

An example might make this more clear:

Menu Bar: File Customers Piracy Issues Administration

Each of these topics has a list of selections when it is clicked.

I want to allow visibility of say, Administration based on the Loggedon
Username. Is this possible? If so, can you help me with the syntax?

Thanks,
Jim
 
Ad

Advertisements

J

Jack Leach

To programmatically access the MenuBar (commandbars) collection(s), you need
a reference to Microsoft Office XX.0 Object Library (fill in XX with your
version of Access/Office).

Access the menu bar itself through the CommandBars collection. Then, each
file/tab on the menu is in the Controls collection of the CommandBar (and
subsequently, each further branch of those Controls are in the Controls'
Controls collection.... confused yet?? :)

ex.
(Administration -> Dataset Utilities)


Dim cb As CommandBar
Dim cbc As CommandBarControl
Dim cb2 As CommandBarControl

Set cb = Application.CommandBars("yourmenuname")
Set cbc = cb.Controls("Administration")
Set cbc2 = cbc.Controls("Dataset Utilities")

If <not administrator login condition> Then
cbc.Visible = False 'or maybe
cbc.Enabled = False
End If


or, if you don't want to reference all the object variables, do it directly
(watch for word wrap)

Application.CommandBars("YourMenuBarName").Controls("Administration").Visible = False



etc., etc.


hth

--
Jack Leach
www.tristatemachine.com

"I haven''t failed, I''ve found ten thousand ways that don''t work."
-Thomas Edison (1847-1931)
 
J

Jim Evans

Jack,

Thanks very much.

I really admire the clarity and scope of your responses.

I have tried your suggestions and I now have control over my CommandBars!
 
J

Jack Leach

Thanks Jim, glad to have been able to help.

If you'd like I've got a number of functions for handling various common
tasks related to user permissions ad commandbars. One in particular that I
found to be quite handy recursively calls each "layer" of bars, so you can
programmatically set the visibility to false on every single control in the
menu when the user logs in.

I noticed that if subsequent controls weren't turned off when I logged a
user in, when I made the top level visible, they might be able to see
next-level controls, which I didn't want, and the only way to ensure that
they got only what I wanted them to have was to set *everything* to
visible=false and then turn the applicable ones on one by one.

Anyway if you're interested later today I can post some of these functions
that I've re-written a few times now and should (hopefully!) be suitable for
the public :) Maybe save you a few minutes down the road.

--
Jack Leach
www.tristatemachine.com

"I haven''t failed, I''ve found ten thousand ways that don''t work."
-Thomas Edison (1847-1931)
 
J

Jim Evans

Jack,

That would be great and I am certain that I will not be the only one to
benefit from your generosity.

Thanks.
Jim
 
J

Jack Leach

The two functions below effectively turn the visiblility of every control in
the menubar to False (or true if you pass it). I run this on startup to give
a "clean slate" so to speak, and when the user logs in I run a loop on the
main menu permissions table for that user. I got very sick of recoding every
time I modified the menubar, hence this was born. I use a junction table of
Users/Menu permissions to turn specific menus back on when the user logs in,
but the procedure is rather specific to my setup so I left it out. Hopefully
you can find some use from this.

Call like so:

MenuControlsVisible "YourMenuName"





Option Compare Database
Option Explicit


'==============================================================================
' NAME: MenuControlsVisible
' DESC: Sets Visible property for every nested control in the passed
commandbar
' DEPENDANCY: pfRecurseControls(
'==============================================================================
'ErrStrV3.00
Public Function MenuControlsVisible( _
sMenuName As String, _
Optional bVisible As Boolean = False _
) As Boolean
On Error GoTo Error_Proc
Dim Ret As Boolean
'=========================
Dim cbarc As CommandBarControl
'=========================

For Each cbarc In CommandBars(sMenuName).Controls
pfRecuseControls cbarc, bVisible
Next cbarc

Ret = True
'=========================
Exit_Proc:
Set cbarc = Nothing
MenuControlsVisible = Ret
Exit Function
Error_Proc:
MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: modMenuBars, Procedure: MenuControlsVisible" _
, vbCritical, "Error!"
Resume Exit_Proc
Resume
End Function



'==============================================================================
' NAME: pfRecuseControls
' DESC: recurses itself for each nested set of controls foun
'==============================================================================
'ErrStrV3.00
Private Function pfRecuseControls( _
cbarc As CommandBarControl, _
bVisible As Boolean _
)
On Error GoTo Error_Proc
'=========================
Dim ctl As CommandBarControl
'=========================

'find out if there's a controls collection
On Error Resume Next
Set ctl = cbarc.Controls(1)

If Err.Number = 0 Then
'theres further controls... handle them
Err.Clear
On Error GoTo Error_Proc

'recurse the function for the next nested set
For Each ctl In cbarc.Controls
pfRecuseControls ctl, bVisible
Next

ElseIf Err.Number = 438 Then
'no controls collection
Err.Clear
On Error GoTo Error_Proc

Else
'unexpected error
GoTo Error_Proc
End If

cbarc.Visible = bVisible

'=========================
Exit_Proc:
Set cbarc = Nothing
Exit Function
Error_Proc:
MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: modMenuBars, Procedure: pfRecuseControls" _
, vbCritical, "Error!"
Resume Exit_Proc
Resume
End Function






--
Jack Leach
www.tristatemachine.com

"I haven''t failed, I''ve found ten thousand ways that don''t work."
-Thomas Edison (1847-1931)
 
Ad

Advertisements

J

Jim Evans

Jack,

Based on a post of yours some time ago, I am developing a template db that
includes security that I am creating, based on tables.

I would really like to see the portion that you left out because it sounds
as if it may apply to what I am building now.

If you have any other material regarding this type of security system, I
would love to see it.

thanks,

Jim
 
J

Jack Leach

It's a bit clunky, but I'll explain what's going on as best I can...

Disclaimer: This is probably NOT the best way to go about it, but it works
for my purposes so far. My only issue with it is that I don't have a
recursive function for reading the level on controls. Right now my controls
are only nested 2 deep... I stopped playing around with the module at some
point, other things to do, and it works for me now but is not quite ideal as
of yet. It's not far off, but it still needs a little work.

I hope you find this useful, quite frankly this was a real pain to pull
together and refresh myself on what I have going on. Luckily I included at
least some minor commenting to help me out. I don't mind, as long as
someone's getting some use out of it...


Overview:
The default main menu is turned off, replaced with a custom menubar named
"dsMenu". The File menu is setup up on it's own, regardless of user status.
The items are either enabled or disabled depending on whether a user is
currently logged in or not. Constants are used for the menu and menuitem
names to avoid hardcoding directly to the procedures. The functions are
called from startup in this sequence...

Startup: DSMenuLoggedState False
Login: DSMenuLoggedState True
SetUserMenus
Logout: DSMenuLoggedState False

You'll notice that the DSMenuLoggedState function includes a call to the
previously posted MenuControlsVisible, so on logout by calling the
LoggedState function you are inherently turning visibility off to all of the
controls.

The status of a logged user is held in a Public Property called gUSER. As a
side note, on Shutdown, the code checks for the existence of a user in the
gUSER property and runs the logout procedure if gUSER has a value. Also,
you'll notice that the SetUserMenus function references qryUMenus... this
query is a record listing of jtblUMenus (see below) based on the current
status of gUSER. If gUSER is blank, there qryUMenus contains no records and
therefore no changes are made to the menubar. This qry pulls values from
jtblUMenus and corresponding values from tblMenus, filtered by the active
user.

Here's the three tables that I use for this:
tblUsers
fldUser (PK - Text)
tblMenus
fldID (PK - Long Int)
fldName (str - ex "File" or "Reporting")
fldControlLevel (Integer - Level in Menu)
1 - Base level (on menu itself) (ex. Reporting)
2 - 2nd Level, ex Reporting -> Company Reports
fldParent (Long - fldID reference to the parent control)
this is only applicable on level 2+ ControlLevels
fldCommand (str - Function to run, ex dsCmdRunUMCompanies())
jtblUMenus (Junction table between tblUsers and tblMenus)
fldUser (PK - Text)
fldMenu (PK - Long Integer)
fldEnabled (Integer)

SQL for qryUMenus:

SELECT jtblUMenus.fldUser,
jtblUMenus.fldMenu,
jtblUMenus.fldEnabled,
tblMenus.fldName,
tblMenus.fldControlLevel,
tblMenus.fldParent
FROM jtblUMenus, tblMenus
WHERE ((([jtblUMenus].[fldUser])=gUSER()))
ORDER BY tblMenus.fldControlLevel;



And finally, the code....


'==============================
Option Compare Database
Option Explicit


' PUBLIC CONST FOR dsMENU NAME
Public Const cMB_DSMENU As String = "dsMenu"


'PRIVATE CONSTANTS FOR DSMENU

Private Const pcFILE As String = "File"
Private Const pcFILELOGIN As String = "Login"
Private Const pcFILELOGOUT As String = "Logout"
Private Const pcFILEEXIT As String = "Exit"



'==============================================================================
' NAME: DSMenuLoggedState
' DESC: Formats the File menu on dsMenu for logged out/in states
' This will run before user-specific menus on logi
'==============================================================================
'ErrStrV3.00
Public Function DSMenuLoggedState(bLogged As Boolean) As Boolean
On Error GoTo Error_Proc
Dim Ret As Boolean
'=========================
Dim cbar As CommandBar
Dim cbarc As CommandBarControl
'=========================

DoCmd.Echo False

'init visibility false on all commandbars
MenuControlsVisible cMB_DSMENU


'set command bar
Set cbar = Application.CommandBars(cMB_DSMENU)
cbar.Visible = True
cbar.Enabled = True


'Set File and Subsidaries
For Each cbarc In cbar.Controls(pcFILE).Controls
cbarc.Visible = True
Next
Set cbarc = Nothing

Set cbarc = cbar.Controls(pcFILE)
With cbarc
.Visible = True
.Enabled = True
.Controls(pcFILELOGIN).Enabled = Not bLogged
.Controls(pcFILELOGOUT).Enabled = bLogged
.Controls(pcFILEEXIT).Enabled = True
End With

Set cbarc = Nothing


Ret = True
'=========================
Exit_Proc:
DoCmd.Echo True
Set cbar = Nothing
Set cbarc = Nothing
DSMenuLoggedState = Ret
Exit Function
Error_Proc:
DoCmd.Echo True
MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: modMenuBars, Procedure: DSMenuLoggedState" _
, vbCritical, "Error!"
Resume Exit_Proc
Resume
End Function



'==============================================================================
' NAME: SetUserMenus
' DESC: Loops the qryUMenus and handles each menuitem accordingly
'
' !!!!!!! CURRENTLY HANDLES UP TO LEVEL 2 CONTROL ONLY !!!!!!!!!
'
'==============================================================================
'ErrStrV3.00
Public Function SetUserMenus() As Boolean
On Error GoTo Error_Proc
Dim Ret As Boolean
'=========================
Dim cbar As CommandBar 'dsMenu
Dim cbarc1 As CommandBarControl 'ControlLevel1 controls
Dim cbarc2 As CommandBarControl 'ControlLevel2 controls
Dim rs As DAO.Recordset 'qryUMenus
Dim sName As String 'control name
'=========================

'set dsMenu (cbar)
Set cbar = Application.CommandBars(cMB_DSMENU)

Set rs = CurrentDb.OpenRecordset("qryUMenus")
If rs.RecordCount <> 0 Then
rs.MoveFirst

While Not rs.EOF

'init cbarc's
Set cbarc1 = Nothing
Set cbarc2 = Nothing

If rs("fldControlLevel") = 1 Then
'this is a base control, no parent settings needed
'level 1 controls are automatically visible and have no enabled
setting
sName = rs("fldName")
cbar.Controls(sName).Visible = True

ElseIf rs("fldControlLevel") = 2 Then
'this is a second level control, 1 parent setting is required (cbarc1)

'set the parent control (cbarc1)
sName = ELookup("fldName", "tblMenus", "fldID = " & rs("fldParent"))
Set cbarc1 = cbar.Controls(sName)

'set the target control (cbarc2)
sName = rs("fldName")
Set cbarc2 = cbarc1.Controls(sName)

'set visible and enabled properties
cbarc2.Visible = True
cbarc2.Enabled = rs("fldEnabled")

End If

rs.MoveNext
Wend
End If

rs.Close

Ret = True
'=========================
Exit_Proc:
Set rs = Nothing
Set cbar = Nothing
Set cbarc1 = Nothing
Set cbarc2 = Nothing
SetUserMenus = Ret
Exit Function
Error_Proc:
rs.Close
MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: modMenuBars, Procedure: SetUserMenus" _
, vbCritical, "Error!"
Resume Exit_Proc
Resume
End Function

'==============================================================================
' NAME: RunMenuCmd
' DESC: Runs command based on passed Menu Index
' The Action event for the command in the menubar control
properties is set with the control's ID as the argument
' modCommands has the actual functions as stored in tblMenus
'==============================================================================
'ErrStrV3.00
Public Function RunMenuCmd(lIndex As Long) As Long
On Error GoTo Error_Proc
Dim Ret As Long
'=========================
Dim sCommand As String 'command to run
Dim x As Variant 'dummy return for Eval
'=========================

sCommand = Nz(ELookup("fldCommand", "tblMenus", "fldID = " & lIndex), "")

'verify return
If Len(sCommand) = 0 Then
MsgBox "An error has occured running a menu command." _
, vbCritical + vbOKOnly, "Error!"
GoTo Exit_Proc
End If


x = Eval(sCommand)

'=========================
Exit_Proc:
Exit Function
Error_Proc:

If Err.Number = 2425 Then 'command not found
MsgBox "An error has occured running a menu command." _
, vbCritical + vbOKOnly, "Error!"
Resume Exit_Proc
End If

MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: modMenuBars, Procedure: RunMenuCmd" _
, vbCritical, "Error!"
Resume Exit_Proc
Resume
End Function













'==============================================================================
' NAME: MenuControlsVisible
' DESC: Sets Visible property for every nested control in the passed
commandbar
' DEPENDANCY: pfRecurseControls()
'==============================================================================
'ErrStrV3.00
Public Function MenuControlsVisible( _
sMenuName As String, _
Optional bVisible As Boolean = False _
) As Boolean
On Error GoTo Error_Proc
Dim Ret As Boolean
'=========================
Dim cbarc As CommandBarControl
'=========================

For Each cbarc In CommandBars(sMenuName).Controls
pfRecuseControls cbarc, bVisible
Next cbarc

Ret = True
'=========================
Exit_Proc:
Set cbarc = Nothing
MenuControlsVisible = Ret
Exit Function
Error_Proc:
MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: modMenuBars, Procedure: MenuControlsVisible" _
, vbCritical, "Error!"
Resume Exit_Proc
Resume
End Function




'==============================================================================
' NAME: pfRecuseControls
' DESC: recurses itself for each nested set of controls found
'==============================================================================
'ErrStrV3.00
Private Function pfRecuseControls( _
cbarc As CommandBarControl, _
bVisible As Boolean _
)
On Error GoTo Error_Proc
'=========================
Dim ctl As CommandBarControl
'=========================

'find out if there's a controls collection
On Error Resume Next
Set ctl = cbarc.Controls(1)

If Err.Number = 0 Then
'theres further controls... handle them
Err.Clear
On Error GoTo Error_Proc

'recurse the function for the next nested set
For Each ctl In cbarc.Controls
pfRecuseControls ctl, bVisible
Next

ElseIf Err.Number = 438 Then
'no controls collection
Err.Clear
On Error GoTo Error_Proc

Else
'unexpected error
GoTo Error_Proc
End If

cbarc.Visible = bVisible

'=========================
Exit_Proc:
Set cbarc = Nothing
Exit Function
Error_Proc:
MsgBox "Error: " & Trim(Str(Err.Number)) & vbCrLf & _
"Desc: " & Err.Description & vbCrLf & vbCrLf & _
"Module: modMenuBars, Procedure: pfRecuseControls" _
, vbCritical, "Error!"
Resume Exit_Proc
Resume
End Function






--
Jack Leach
www.tristatemachine.com

"I haven''t failed, I''ve found ten thousand ways that don''t work."
-Thomas Edison (1847-1931)
 
S

Stuart McCall

Jack
I don't have a recursive function for reading the level on controls
Take a look at the FindControl method. It can to the recursion for you
(although you need to set your controls' Tag in order to use it)

HTH
 
Ad

Advertisements

J

Jack Leach

Thanks Stuart, I'll give this a look, it certainly sounds helpful. Maybe I
should make it a point to review the object model before I try to reinvent
wheels through code....
--
Jack Leach
www.tristatemachine.com

"I haven''t failed, I''ve found ten thousand ways that don''t work."
-Thomas Edison (1847-1931)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top