Access custom right click filter menus-CodePudding

I want to create custom right click filter menus in Access. I got code that does that, it's below

here's the problem. obviously, a field can be text or numbers. the default Access menu deals with that by creating a group Number Filters or Text Filters. But my filter doesn't have those groups, and, more importantly, doesn't look at the field type and doesn't hide irrelevant menus like the native one does. In the native one, it seems that they look at the field type, and, based on that, show TEXT FILTERS or NUMBER FILTERS

how do i do that without doing horrible things like program OnClick of every control and reload the menu based on the field type? like, is there a way to mimic what Access does? Hide irrelevant menus or show a different group based on field type

    Public Sub sbFormsShortcutMenu()

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

On Error Resume Next

CommandBars("MainRightClick").Delete
Set cmbRightClick = CommandBars.Add("MainRightClick", msoBarPopup, False, True) 'NEW COMMANDBAR
 
With cmbRightClick
    
        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, 210, , , True) 'Sort AZ 10068
        cmbControl.BeginGroup = True
        Set cmbControl = .Controls.Add(msoControlButton, 211, , , True) 'Sort ZA 10068
        Set cmbControl = .Controls.Add(msoControlButton, 10068, , , True) 'FilterEqualsSelection 10068
        cmbControl.BeginGroup = True
        Set cmbControl = .Controls.Add(msoControlButton, 10071, , , True) 'FilterNotEqualsSelection 10071
        Set cmbControl = .Controls.Add(msoControlButton, 10090, , , True) 'FilterBeginsWithSelection 10090
        Set cmbControl = .Controls.Add(msoControlButton, 12265, , , True) 'FilterDoesNotBeginsWithSelection 12265
        Set cmbControl = .Controls.Add(msoControlButton, 10076, , , True) 'FilterContainsSelection 10076
        Set cmbControl = .Controls.Add(msoControlButton, 10089, , , True) 'FilterDoesNotContainSelection 10089
        Set cmbControl = .Controls.Add(msoControlButton, 10091, , , True) 'FilterEndsWithSelection 10091
        Set cmbControl = .Controls.Add(msoControlButton, 12266, , , True) 'FilterDoesNotEndWithSelection 12266 
        Set cmbControl = .Controls.Add(msoControlButton, 10095, , , True) 'FilterSmallerThanSelection 10095
        Set cmbControl = .Controls.Add(msoControlButton, 10094, , , True) 'FilterLargerThanSelection 10094
        Set cmbControl = .Controls.Add(msoControlButton, 10062, , , True) 'FilterBetween 10062 
        Set cmbControl = .Controls.Add(msoControlButton, 640, , , True) 'FilterBySelection 640
        Set cmbControl = .Controls.Add(msoControlButton, 3017, , , True) 'FilterExcludingSelection 3017

End With

    Set cmbControl = Nothing
    Set cmbRightClick = Nothing
        
End Sub

CodePudding user response：

I ended up programming every control. I created 2 versions of the above code, here they go

Public Sub sbFormsShortcutMenuNumber()

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

On Error Resume Next

CommandBars("MainRightClick").Delete
Set cmbRightClick = CommandBars.Add("MainRightClick", msoBarPopup, False, True) 'NEW COMMANDBAR
 
With cmbRightClick
    
        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, 210, , , True) 'Sort AZ 10068
        cmbControl.BeginGroup = True
        Set cmbControl = .Controls.Add(msoControlButton, 211, , , True) 'Sort ZA 10068
        Set cmbControl = .Controls.Add(msoControlButton, 10068, , , True) 'FilterEqualsSelection 10068
        cmbControl.BeginGroup = True
        Set cmbControl = .Controls.Add(msoControlButton, 10071, , , True) 'FilterNotEqualsSelection 10071
        Set cmbControl = .Controls.Add(msoControlButton, 10095, , , True) 'FilterSmallerThanSelection 10095
        Set cmbControl = .Controls.Add(msoControlButton, 10094, , , True) 'FilterLargerThanSelection 10094
        Set cmbControl = .Controls.Add(msoControlButton, 10062, , , True) 'FilterBetween 10062
        Set cmbControl = .Controls.Add(msoControlButton, 640, , , True) 'FilterBySelection 640
        Set cmbControl = .Controls.Add(msoControlButton, 3017, , , True) 'FilterExcludingSelection 3017

End With

    Set cmbControl = Nothing
    Set cmbRightClick = Nothing
        
End Sub

Public Sub sbFormsShortcutMenuText()

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

On Error Resume Next

CommandBars("MainRightClick").Delete
Set cmbRightClick = CommandBars.Add("MainRightClick", msoBarPopup, False, True) 'NEW COMMANDBAR
 
With cmbRightClick
    
        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, 210, , , True) 'Sort AZ 10068
        cmbControl.BeginGroup = True
        Set cmbControl = .Controls.Add(msoControlButton, 211, , , True) 'Sort ZA 10068
        Set cmbControl = .Controls.Add(msoControlButton, 10068, , , True) 'FilterEqualsSelection 10068
        cmbControl.BeginGroup = True
        Set cmbControl = .Controls.Add(msoControlButton, 10071, , , True) 'FilterNotEqualsSelection 10071
        Set cmbControl = .Controls.Add(msoControlButton, 10076, , , True) 'FilterContainsSelection 10076
        Set cmbControl = .Controls.Add(msoControlButton, 10089, , , True) 'FilterDoesNotContainSelection 10089
        Set cmbControl = .Controls.Add(msoControlButton, 640, , , True) 'FilterBySelection 640
        Set cmbControl = .Controls.Add(msoControlButton, 3017, , , True) 'FilterExcludingSelection 3017

End With

    Set cmbControl = Nothing
    Set cmbRightClick = Nothing
        
End Sub

In case someone is wondering, so far, doesn't seem like performance is affected. on the first right-click when first opening the app - there's a slight lag but after that - instant. But I haven't tested it with the backend being on the server, my backend is on my local drive.

Here's the code used for each control. So, every form where you want this done has to have the Shortcut Menu set to whatever you named your shortcut bar (in my case it's "MainRightClick") and this can be automated (create a sub that loops through all forms, opens each in design view and sets the shortcut menu to your menu)

To get it to show up in the dropdowns in the Shortcut Menu option in the form - run the above code. It only has to be run once and it will remember it forever. I still have some old test menus saved somewhere somehow which I cant get rid of. No big deal, they just annoy me showing up in the dropdown in design mode :)

Anyway, and then, for each control do this

Private Sub FirstName_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = acRightButton Then
        If IsNumeric(Me.FirstName) Then
            sbFormsShortcutMenuNumber
            Else
            sbFormsShortcutMenuText
        End If
    End If End Sub

I automated this entire process so that I can do this for all my apps and it's not so bad after all

CodePudding user response：

Check the following code

Public Function sbFormsShortcutMenu()  'Make it function not sub

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

    On Error Resume Next

    CommandBars("MainRightClick").Delete
    Set cmbRightClick = CommandBars.Add("MainRightClick", msoBarPopup, False, True) 'NEW COMMANDBAR

    With cmbRightClick

        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, 210, , , True) 'Sort AZ 10068
        cmbControl.BeginGroup = True
        Set cmbControl = .Controls.Add(msoControlButton, 211, , , True) 'Sort ZA 10068
        Set cmbControl = .Controls.Add(msoControlButton, 10068, , , True) 'FilterEqualsSelection 10068
        cmbControl.BeginGroup = True
        Set cmbControl = .Controls.Add(msoControlButton, 10071, , , True) 'FilterNotEqualsSelection 10071
        If IsNumeric(Me.ActiveControl) then  'Check if numeric add numeric options and if not add text options
            Set cmbControl = .Controls.Add(msoControlButton, 10095, , , True) 'FilterSmallerThanSelection 10095
            Set cmbControl = .Controls.Add(msoControlButton, 10094, , , True) 'FilterLargerThanSelection 10094
            Set cmbControl = .Controls.Add(msoControlButton, 10062, , , True) 'FilterBetween 10062
        Else
            Set cmbControl = .Controls.Add(msoControlButton, 10076, , , True) 'FilterContainsSelection 10076
            Set cmbControl = .Controls.Add(msoControlButton, 10089, , , True) 'FilterDoesNotContainSelection 10089                
        End If
        Set cmbControl = .Controls.Add(msoControlButton, 640, , , True) 'FilterBySelection 640
        Set cmbControl = .Controls.Add(msoControlButton, 3017, , , True) 'FilterExcludingSelection 3017

    End With

    Set cmbControl = Nothing
    Set cmbRightClick = Nothing
    
End Sub

Then use =sbFormsShortcutMenu() in each click event of your controls on the form. This would make the solution general for any form and any control on it for Numeric and Text type controls. Of course you could extend it more to check for Date type controls as well and update the menu accordingly :)