Control Ids For Report Shortcut Items

[RossWaddell]

I've used a list of available menubar control IDs for making my own shortcut menus in Access 97/2003 before, but I can't seem to find the same thing for Access 2016. I've looked through 'accesscontrols.xlsx' (Office 2016 UI Help Files) downloaded from the Microsoft site, but can't locate the items highlighted in the attached photo - can anyone help me find the IDs? I've attached a zip file with my screenshots as I've not yet reached 10 posts.

(Note that the 'Close' item works on my custom shortcut but doesn't look the same as the one from the out-of-the-box report shortcut)

And here's the code I'm using to create my custom report shortcut:

Public Function AddCustomPrintPreviewShrtCutMenu()
'   Create custom print preview shortcut menu
    Dim cbar As CommandBar
    Dim cbarCtrl As CommandBarControl

    On Error Resume Next
    CommandBars("Wfest PrntPrevShrtCut").Delete
    
    On Error GoTo GEH
    
    Set cbar = CommandBars.Add("Wfest PrntPrevShrtCut", msoBarPopup)

    ' (1) Add "Zoom"
'    Set cbarCtrl = cbar.Controls.Add(Type:=msoControlDropdown, ID:=15993)

    ' (2) Add "One Page" toggle
'    Set cbarCtrl = cbar.Controls.Add(ID:=5) Works, but not needed if the Zoom & Multiple Pages can't be added
    
    ' (3) Add "Multiple Pages >"
'    Set cbarCtrl = cbar.Controls.Add(Type:=msoControlPopup, ID:=15069)
    
    ' (4) Add "Page Setup..."
    Set cbarCtrl = cbar.Controls.Add(ID:=247)
'    With cbarCtrl
'        .BeginGroup = True
'    End With
    
    ' (5) Add "Print..."
    Set cbarCtrl = cbar.Controls.Add(ID:=15948)

    ' (6) Add "Save As..."
    Set cbarCtrl = cbar.Controls.Add(ID:=748)
    With cbarCtrl
        .BeginGroup = True
    End With




    ' (7) Add "Close"
    Set cbarCtrl = cbar.Controls.Add(ID:=923)
    With cbarCtrl
        .BeginGroup = True
    End With
    
Exit_Function:
    Set cbarCtrl = Nothing
    Set cbar = Nothing
    Exit Function

GEH:
    MsgBox Str(Err.Number) & ": " & Err.Description, vbOKOnly + vbCritical, APP_TITLE & " - AddCustomPrintPreviewShrtCutMenu()"
    Resume Exit_Function
End Function

(The ones commented out are what I thought were the right items, but they threw an error)

 

[arnelgp]

maybe this link will help you.
https://www.microsoft.com/en-us/download/details.aspx?id=3582

 

[RossWaddell]

Thanks arnelgp, but that's where I got the 'accesscontrols.xlsx' file from. While it lists controls seen on the ribbon (and from which I've grabbed the idMso value to use in my own custom ribbon), I'm not sure it includes all controls from the shortcut popup menus. As you can see from my code, I tried using some of the Ids I found in that spreadsheet but they threw errors.

 

[arnelgp]

how about this one:

http://supportingtech.blogspot.com/2011/03/microsoft-faceid-numbers-for-vba.html

 

[arnelgp]

copy and paste to module, this will list all face ids. after running, you can view it in ADD-INS tab.

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

 

[RossWaddell]

Thanks arnelgp, but those are meant to use if you want the grab the icon only for your custom menu item. The FaceID property does not set the behaviour, just the icon.

 

[RossWaddell]

Figured out code to print out the name of specific commandbars which have 'Print' in their name, and then the list of controls associated with that commandbar:

Sub ListShrtCutMenubars()
'   List out all commandbars that have "Print" in their name
    Dim cbar As CommandBar
    
    For Each cbar In CommandBars
        If InStr(cbar.Name, "print") > 0 Then
            Debug.Print cbar.Name
        End If
    Next cbar
End Sub

Sub ListPopupControls()
'   List out all controls on a specific commandbar
    Dim cbr As CommandBar
    Dim cbc As CommandBarControl

    Set cbr = CommandBars("Print Preview Popup")
    Debug.Print "Caption,ID,Type"
    For Each cbc In cbr.Controls
        Debug.Print cbc.Caption & "," & cbc.ID & "," & cbc.Type & "," & cbc.visible
    Next cbc

End Sub

I was able to create my custom report shortcut with this code:

Public Function AddCustomPrintPreviewShrtCutMenu()
'   Create custom print preview shortcut menu
    Dim cbar As CommandBar
    Dim cbarCtrl As CommandBarControl

    On Error Resume Next
    CommandBars("Wfest PrntPrevShrtCut").Delete
    
    On Error GoTo GEH
    
    Set cbar = CommandBars.Add("Wfest PrntPrevShrtCut", msoBarPopup)

    ' (1) Add "Zoom"
    Set cbarCtrl = cbar.Controls.Add(Type:=4, ID:=1733)

    ' (2) Add "One Page" toggle
    Set cbarCtrl = cbar.Controls.Add(Type:=1, ID:=5)

    ' (3) Add "Multiple Pages >"
    Set cbarCtrl = cbar.Controls.Add(Type:=16, ID:=177)
    
    ' (4) Add "Page Setup..."
    Set cbarCtrl = cbar.Controls.Add(Type:=1, ID:=247)
    With cbarCtrl
        .BeginGroup = True
    End With
    
    ' (5) Add "Print..."
    Set cbarCtrl = cbar.Controls.Add(Type:=1, ID:=15948)

    ' (6) Add "Save As..."
    Set cbarCtrl = cbar.Controls.Add(Type:=1, ID:=748)
    With cbarCtrl
        .BeginGroup = True
    End With

    ' (7) Add "Export"
'    Set cbarCtrl = cbar.Controls.Add(Type:=10, ID:=31458) 'This should work, but throws an error

    ' (8) Add "Send To"
    Set cbarCtrl = cbar.Controls.Add(Type:=10, ID:=30095)

    ' (9) Add "Close"
    Set cbarCtrl = cbar.Controls.Add(Type:=1, ID:=14782)
    With cbarCtrl
        .BeginGroup = True
    End With
    
Exit_Function:
    Set cbarCtrl = Nothing
    Set cbar = Nothing
    Exit Function

GEH:
    MsgBox Str(Err.Number) & ": " & Err.Description, vbOKOnly + vbCritical, APP_TITLE & " - AddCustomPrintPreviewShrtCutMenu()"
    Resume Exit_Function
End Function

For some reason, though, only the Export control throws an error. Anyone know why?