Customize right click menu

samedi 2 mai 2015

I have the following script which customizes the right click menu and I love it.

The problem that I am having is that I call the script to add the right click from the form open event and then multiple users can not access the same database.

I use one for forms and then another for reports.

If I manually close the open forms then reopen them then multiple users can use the same database.

If I close and reopen forms with vba the right click still remains making the database not accessible to multiple users.

It is definitely this as when I comment it out from the open event of the forms then everything is OK.

I call the following from the open event of the form as follows

Code:

Public Sub Form_Open(Cancel As Integer)
FormsShortcutMenu
End Sub

The following is stored in a module

Code:

Public Sub FormsShortcutMenu()

Dim cmbRightClick As Office.CommandBar
Dim cmbControl As Office.CommandBarControl

On Error Resume Next

CommandBars("cmdRightClick").Delete
Set cmbRightClick = CommandBars.Add("cmdRightClick", msoBarPopup, False, True) 'NEW COMMANDBAR
 
With cmbRightClick
   
        Set cmbControl = .Controls.Add(msoControlButton, 502, , , True) ' ViewsFormView
        'Set cmbControl = .Controls.Add(msoControlButton, 2952, , , True) ' ViewsDesignView
       
       
       
        Set cmbControl = .Controls.Add(Type:=msoControlButton) 'design view by closing and reopening form so is quicker
        cmbControl.BeginGroup = True                  ' Add a line to separate above group
        cmbControl.Caption = "Design View Quick Load"        ' Add label the user will see
        cmbControl.FaceId = 2952        ' Add label the user will see
        cmbControl.OnAction = "DesignViewFunctionFORM" ' Add the name of a function to call
       
        Set cmbControl = .Controls.Add(Type:=msoControlButton) 'design view by closing and reopening form so is quicker
        cmbControl.BeginGroup = True                  ' Add a line to separate above group
        cmbControl.Caption = "List Report Name"        ' Add label the user will see
        'cmbControl.FaceId = 2952        ' Add label the user will see
        cmbControl.OnAction = "TestingReportName" ' Add the name of a function to call
       
        Set cmbControl = .Controls.Add(Type:=msoControlButton) 'design view by closing and reopening form so is quicker
        cmbControl.BeginGroup = True                  ' Add a line to separate above group
        cmbControl.Caption = "List Form Name"        ' Add label the user will see
        'cmbControl.FaceId = 2952        ' Add label the user will see
        cmbControl.OnAction = "TestingFormName" ' Add the name of a function to call
       
       
       
        Set cmbControl = .Controls.Add(msoControlButton, 12329, , , True) ' ViewsDatasheetView
        Set cmbControl = .Controls.Add(msoControlButton, 5814, , , True) ' ViewsPivotTableView
        Set cmbControl = .Controls.Add(msoControlButton, 5815, , , True) ' ViewsPivotChartView
        Set cmbControl = .Controls.Add(msoControlButton, 21, , , True) ' Cut
        Set cmbControl = .Controls.Add(msoControlButton, 19, , , True) ' Copy
        Set cmbControl = .Controls.Add(msoControlButton, 22, , , True) ' Paste
        Set cmbControl = .Controls.Add(msoControlButton, 222, , , True) ' PropertySheet
        Set cmbControl = .Controls.Add(msoControlButton, 14782, , , True) ' close

End With

    Set cmbControl = Nothing
    Set cmbRightClick = Nothing
       
End Sub

Customize right click menu

0 commentaires:

Enregistrer un commentaire

Labels