ShortCut Menu (1 Viewer)

[Sun_Force]

I'm following This MS Document to add a context menu to a form and I think I need your help again.

I appreciate any kind of advice to any of these questions:

• How can I add an image to a menu? .imageMso="CreateTableTemplatesGallery" brings up unsupported property error.(Solved)
• How can I pass a parameter to the function that will be run? I tried .OnAction="Test 'myPar'" but I receive a Can not find callback function error. I prefer not to use screen.ActiveForm or Screen.ActiveControl in the target function as much as possible. Because the function will be called from other procedures too.
• Is there any way to add a context menu using xml? Just like ribbons. I have a feeling it may be much more flexible.

Thanks again for the time you put into this.

 

[arnelgp]

you need to Search for FaceID.

 

[arnelgp]

CreateTableTemplatesGallery

are you sure this is Command/Group in the Ribbon?

 

[Sun_Force]

are you sure this is Command/Group in the Ribbon?

No.
But it's listed in Office imagemso .
And this is what it looks like:

An excel file is attached.
Go to Developer Tab. You'll see 9 drop downs. All Office iamgeMso is listed. Selecting any of them, the name will be shown in the middle of the worksheet.
As far as I remember, I downlloaded this file from MSDN.

IF you don't have developer tab, you have to activate it in Options - Customize Ribbons.

 

[arnelgp]

faceID of what you showed is 8.

 

[Sun_Force]

you need to Search for FaceID.

Do you have a working example?
I'm still receiving type mismatch error with FaceID.

Edit: I had to remove quotation marks. With FaceID I was able to add the image.
thank you.

 

[Sun_Force]

faceID of what you showed is 8.

How did you convert it?
Is there any table for this?
thanks.

 

[arnelgp]

How did you convert it?

you google "FaceID in ms access", you will find a sample with add-in.

Do you have a working example?
I'm still receiving type mismatch error with FaceID.

it's because the example is using "internal" (built-in) shortcut menus (the last parameter of .Controls.Add, it is set to True).
what i have is this:

Private Sub subCreateReportShortcut()
    'arnelgp
    Const SHORTCUT_NAME As String = "menu_print"
    Dim cbar As CommandBar
    Dim bt As CommandBarButton
    On Error Resume Next
    CommandBars("menu_print").Delete
    Set cbar = CommandBars.Add(SHORTCUT_NAME, msoBarPopup, , False)
    Set bt = cbar.Controls.Add
    bt.Caption = "Print Report"
    bt.OnAction = "=fncPrint()"
    bt.FaceId = 8
    Set bt = cbar.Controls.Add
    bt.BeginGroup = True
    bt.Caption = "Close"
    bt.OnAction = "=fncCloseReport()"
End Sub

Public Function fncPrint()
On Error Resume Next
'DoCmd.RunCommand acCmdPrintSelection
CommandBars.ExecuteMso "PrintDialogAccess"
End Function

Public Function fncCloseReport()
    DoCmd.Close
End Function

 

[arnelgp]

when you install the add-in you'll get like this in Add-ins menu in the Ribbon:

make sure to install/run the add-in to a "blank" database (not the one you plan to distribute).

 

[arnelgp]

sorry, the FaceID is a VBA.
copy this to a New database in New Module, and run ShowFaceIDs sub.
credit to the owner (that was long time ago).

Option Compare Database
Option Explicit

Const cBarName = "FaceIds"

Private iFirstIcon As Integer

Public Sub ShowFaceIds()
    iFirstIcon = 0
    InitBar
    SetBar
End Sub

Private Sub InitBar()
    Dim cbr As CommandBar
    Dim cmdNext As CommandBarButton
    Dim cmdPrevious As CommandBarButton
    Dim cmdRange As CommandBarButton
    
    If CBRExists(cBarName) = True Then
        CommandBars(cBarName).Delete
    End If
    
    Set cbr = CommandBars.Add(cBarName)
    cbr.POSITION = msoBarFloating
    
    Set cmdPrevious = cbr.Controls.Add
    cmdPrevious.Caption = "<<Previous"
    cmdPrevious.OnAction = "=FaceIdPrevious()"
    cmdPrevious.Style = msoButtonCaption
    cmdPrevious.Width = 80
    
    Set cmdRange = cbr.Controls.Add
    cmdRange.Style = msoButtonCaption
    
    Set cmdNext = cbr.Controls.Add
    cmdNext.Caption = "Next>>"
    cmdNext.OnAction = "=FaceIdNext()"
    cmdNext.Style = msoButtonCaption
    cmdNext.Width = 80
    
    cbr.Visible = True
    
    Set cbr = Nothing
    Set cmdNext = Nothing
    Set cmdPrevious = Nothing
    Set cmdRange = Nothing
End Sub

Private Sub SetBar()
    Dim cbr As CommandBar
    Dim CBC As CommandBarButton
    Dim i As Integer
    
    If iFirstIcon = 0 Then iFirstIcon = 1
    Set cbr = CommandBars(cBarName)
    
    'Remove all buttons
'    For I = CBR.Controls.Count To 4 Step -1
'        CBR.Controls(I).Delete
'    Next
    
    'Set new buttons
    For i = iFirstIcon To iFirstIcon + 100
        If cbr.Controls.count < 104 Then
            Set CBC = cbr.Controls.Add
        Else
            Set CBC = cbr.Controls(i - iFirstIcon + 4)
        End If
        CBC.Style = msoButtonIcon
        CBC.Caption = i
        CBC.FaceId = i
        CBC.TooltipText = i
        CBC.Visible = True
    Next
    SetRangeButton iFirstIcon & "-" & iFirstIcon + 100
    cbr.Height = CBC.Height * 10
    cbr.Width = CBC.Width * 10
    cbr.Visible = True
    
    Set CBC = Nothing
    Set cbr = Nothing
End Sub

Private Function CBRExists(sName As String) As Boolean
    Dim cbr As CommandBar
    On Error Resume Next
    Set cbr = CommandBars(sName)
    If Err.Number <> 0 Then
        Err.Clear
        CBRExists = False
    Else
        Set cbr = Nothing
        CBRExists = True
    End If
    Set cbr = Nothing
End Function

Public Function FaceIdNext()
    iFirstIcon = iFirstIcon + 100
    EnablePreviousButton True
    SetBar
End Function

Public Function FaceIdPrevious()
    iFirstIcon = iFirstIcon - 100
    If iFirstIcon > 0 Then
        SetBar
    Else
        EnablePreviousButton False
    End If
End Function

Private Sub SetRangeButton(sCaption As String)
    CommandBars(cBarName).Controls(2).Caption = sCaption
End Sub

Private Sub EnablePreviousButton(bEnable As Boolean)
    CommandBars(cBarName).Controls(1).Enabled = bEnable
End Sub

Private Sub EnableNextButton(bEnable As Boolean)
    CommandBars(cBarName).Controls(3).Enabled = bEnable
End Sub