UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Custom Shortcut Menu, Access 2013    
 
   
Cabimero-Flanker
post Mar 20 2015, 03:29 AM
Post#1



Posts: 16
Joined: 23-May 13



Dear UT Users:

I been scratching my head, reading every forum available, googling for hours and i cannot decypher this. Tried to do it with macros...cant...tried with tables, also cant. Basically i want to have a custom shortcut menu as the one on Fig 1 BUT without the "design views" and all the database editing views available of the default shortcut menu that is embedded in Access. I mean if i could make a copy of this menu and then edit it, that would solve everything...

FYI, this is the first time i am doing something like this, and i am a intermediate VBA programmer which means that complex coding is elusive for me....anyway; what i has been able to do so far is this:

CODE
Sub CreateSimpleShortcutMenu()

  On Error Resume Next 'If menu with same name exists delete
  CommandBars("ShowDataShortcutMenu").Delete
  
  Dim cmb As CommandBar
  
  Set cmb = CommandBars.Add("ShowDataShortcutMenu", msoBarPopup, False, False)
      With cmb
          .Controls.Add(msoControlButton, 21, , , True).BeginGroup = True     'Cut
          .Controls.Add msoControlButton, 19, , , True    'Copy
          .Controls.Add msoControlButton, 22, , , True    'Paste
          .Controls.Add(msoControlButton, 4016, , , True).BeginGroup = True   'Sort Ascending
          .Controls.Add msoControlButton, 4017, , , True  'Sort Decending
          .Controls.Add(msoControlButton, 640, , , True).BeginGroup = True  'Filter By Selection
          .Controls.Add msoControlButton, 605, , , True   'Remove Filter/Sort
          .Controls.Add msoControlButton, 3017, , , True  'Filter Excluding Selection
          .Controls.Add msoControlButton, 10068, , , True 'Filter equals xx
          .Controls.Add msoControlButton, 10071, , , True 'Filter not equal to xx
          .Controls.Add msoControlButton, 10076, , , True 'Filter contains xx
          .Controls.Add msoControlButton, 10089, , , True 'Filter does not contains  xx
          .Controls.Add msoControlButton, 141, , , True   'Find in form
          '.Controls.AddmsoControlButton , 31581, , , True  'Text filters
          .Controls.Add msoControlButton, 10077, , , True 'Filter equals xx
          .Controls.Add msoControlButton, 10078, , , True 'Filter not equal to xx
          .Controls.Add msoControlButton, 10079, , , True 'Filter beings with xx
          .Controls.Add msoControlButton, 12696, , , True 'Filter does not beings with xx
          .Controls.Add msoControlButton, 10080, , , True 'Filter contains xx
          .Controls.Add msoControlButton, 10081, , , True 'Filter does not contains xx
          .Controls.Add msoControlButton, 10082, , , True 'Filter ends with xx
          .Controls.Add msoControlButton, 10083, , , True 'Filter ends with xx
          .Controls.Add msoControlButton, 12697, , , True 'Filter does not ends with xx
          .Controls.Add msoControlButton, 10062, , , True 'Filter between
          .Controls.Add msoControlButton, 12698, , , True 'Filter before xx
          .Controls.Add(msoControlButton, 25, , , True).BeginGroup = True     'Report Zoom
          .Controls.Add msoControlButton, 4, , , True     'Report Print
      End With
      
  Set cmb = Nothing
  
End Sub


When you call this code and run the application what the custom shortcut menu has is shown in Fig 2. As you can see it is long, ugly and shows the same menu for reports, forms, etc...it does not "customize" itself for each type of object. Also it lacks the context menu like the "text filters" in Fig 1.

I know that this has been done a zillion times somewhere. After 5 days looking through all the internet i and unsuccessfully trying; i will be eternally grateful if somebody can take me out of my misery...

Adrian (too old for this i guess)
Attached File(s)
Attached File  Fig_2.jpg ( 37.09K )Number of downloads: 38
Attached File  Fig_1.jpg ( 36.77K )Number of downloads: 7
 
Go to the top of the page
 
pacala_ba
post Mar 20 2015, 09:25 AM
Post#2



Posts: 660
Joined: 19-March 09
From: Europe, SLOVAKIA, Bratislava


do you want ShortcutMenu on tables ?
table.column ?
table.row ?
table.header ?
Go to the top of the page
 
Cabimero-Flanker
post Mar 22 2015, 10:07 PM
Post#3



Posts: 16
Joined: 23-May 13



I will use anything dear pacala_ba....

No clue on how to do them though...
Go to the top of the page
 
pacala_ba
post Mar 26 2015, 10:09 AM
Post#4



Posts: 660
Joined: 19-March 09
From: Europe, SLOVAKIA, Bratislava


CHOISE is on you...
CODE
for i = 1 to application.CommandBars.Count: debug.Print application.CommandBars(i).Name: NEXT I

...OK ?
Go to the top of the page
 
amrut
post Apr 2 2015, 01:26 PM
Post#5



Posts: 16
Joined: 6-June 11



Try the following -
CODE
Sub CreateSimpleShortcutMenu()
      Dim newMenu As CommandBarControl
Dim cmb as CommandBar
  On Error Resume Next 'If menu with same name exists delete
  CommandBars("ShowDataShortcutMenu").Delete

    CommandBars("ShowDataShortcutMenu").Delete

    Set cmb = CommandBars.Add("ShowDataShortcutMenu", msoBarPopup, False, False)
    With cmb
        .Controls.Add(msoControlButton, 21, , , True).BeginGroup = True     'Cut
        .Controls.Add msoControlButton, 19, , , True    'Copy
        .Controls.Add msoControlButton, 22, , , True    'Paste
        Set newMenu = .Controls.Add(msoControlButton, 4016, , , True)
        newMenu.BeginGroup = True
        newMenu.Caption = "&Sort A to Z"
        newMenu.OnAction = "=SortAZ()"
        Set newMenu = .Controls.Add(msoControlButton, 4017, , , True)

        newMenu.Caption = "S&ort Z to A"
        newMenu.OnAction = "=SortZA()"
        .Controls.Add msoControlButton, 605, , , True   'Remove Filter/Sort
        Set newMenu = .Controls.Add(Type:=msoControlPopup)
        newMenu.Caption = "Te&xt Filters"


        newMenu.Controls.Add msoControlButton, 10077, , , True    'Filter equals xx
        newMenu.Controls.Add msoControlButton, 10078, , , True    'Filter not equal to xx
        newMenu.Controls.Add msoControlButton, 10079, , , True    'Filter beings with xx
        newMenu.Controls.Add msoControlButton, 12696, , , True    'Filter does not beings with xx
        newMenu.Controls.Add msoControlButton, 10080, , , True    'Filter contains xx
        newMenu.Controls.Add msoControlButton, 10081, , , True    'Filter does not contains xx
        newMenu.Controls.Add msoControlButton, 10082, , , True    'Filter ends with xx
        newMenu.Controls.Add msoControlButton, 10083, , , True    'Filter ends with xx
        newMenu.Controls.Add msoControlButton, 12697, , , True    'Filter does not ends with xx

    End With

    Set cmb = Nothing
    Set newMenu = Nothing

End Sub

Function SortAZ()
CommandBars.ExecuteMso ("SortUp")
End Function

Function SortZA()
CommandBars.ExecuteMso ("SortDown")
End Function
Go to the top of the page
 
Cabimero-Flanker
post Apr 5 2015, 11:15 PM
Post#6



Posts: 16
Joined: 23-May 13



Sir, much better than the one i had...many many thanks!!!!
Go to the top of the page
 
pacala_ba
post Apr 9 2015, 03:57 AM
Post#7



Posts: 660
Joined: 19-March 09
From: Europe, SLOVAKIA, Bratislava


Table POPUP CommandBars
CODE
If gkl_AC2010 Then
    For I2 = 1 To Application.CommandBars.Count
        Set MyBar00 = Application.CommandBars(I2)
        If Len(Trim(MyBar00.Name)) = 0 And MyBar00.Id = 186 Then
            Set MyBar = Application.CommandBars(I2)
            Exit For
        End If
    Next I2
Else
    Set MyBar = Application.CommandBars("Table Design Datasheet")' HEADER
End If

Application.CommandBars("Table Design Datasheet Row")
Application.CommandBars("Table Design Datasheet Column")
Go to the top of the page
 


Custom Search


RSSSearch   Top   Lo-Fi    17th October 2019 - 03:14 AM