'arnelgp
'arnelgp
Private Sub myPrintReportShortcut()
Dim cmbRightClick As Office.CommandBar
Dim cmbControl As Office.CommandBarControl
Dim SubMenuItm As CommandBarControl
On Error Resume Next
CommandBars("cmdReportRightClick").Delete
On Error GoTo 0
' Create the shortcut menu.
' .Add (Name, Position, MenuBar, Temporary)
Set cmbRightClick = CommandBars.Add("cmdReportRightClick", msoBarPopup, False, False)
With cmbRightClick
' .Add (Type, Id, Parameter, Before, Temporary)
Set cmbControl = .Controls.Add(msoControlButton, 11253, , , False)
' Change the caption displayed for the control.
cmbControl.Caption = "&Report View"
Set cmbControl = .Controls.Add(msoControlButton, 13157, , , False)
' Change the caption displayed for the control.
cmbControl.Caption = "La&yout View"
Set cmbControl = .Controls.Add(msoControlButton, 2952, , , False)
' Change the caption displayed for the control.
cmbControl.Caption = "&Design View"
Set cmbControl = .Controls.Add(msoControlButton, 109, , , False)
cmbControl.Caption = "Print Pre&view"
Set cmbControl = .Controls.Add(msoControlComboBox, 1733, , , False)
cmbControl.Caption = "&Zoom:"
' Start a new group.
cmbControl.BeginGroup = True
Set cmbControl = .Controls.Add(msoControlButton, 5, , , False)
cmbControl.Caption = "&One Page"
Set cmbControl = .Controls.Add(msoControlExpandingGrid, 177, , , False)
cmbControl.Caption = "&Multiple Pages"
Set cmbControl = .Controls.Add(msoControlButton, 247, , , False)
cmbControl.Caption = "Page Set&up..."
' Start a new group.
cmbControl.BeginGroup = True
'custom print
Set cmbControl = .Controls.Add
With cmbControl
.Caption = "Print"
.OnAction = "=fnPrint()"
.FaceId = 745
End With
Set cmbControl = .Controls.Add(msoControlButton, 748, , , False)
cmbControl.Caption = "Save &As..."
' Start a new group.
cmbControl.BeginGroup = True
Set cmbControl = .Controls.Add(msoControlButton, 14782, , , False)
cmbControl.Caption = "&Close"
With .Controls.Add(Type:=msoControlPopup, before:=11)
.Caption = "Sen&d To"
With .Controls.Add(msoControlButton, 2188, , , False)
.Caption = "M&ail Recipient (as Attachment)..."
'.FaceId = 258
'.OnAction = "=fnMyMail()"
End With
End With
' create this sub menu first
With .Controls.Add(Type:=msoControlPopup, before:=11)
.Tag = "submenu1"
.Caption = "&Export"
With .Controls.Add(msoControlButton, 11723)
.Caption = "E&xcel"
End With
With .Controls.Add(msoControlButton, 11724)
.Caption = "SharePoint Li&st"
End With
With .Controls.Add(msoControlButton, 11725)
.Caption = "&Word RTF File"
End With
With .Controls.Add(msoControlButton, 12951)
.Caption = "&PDF or XPS"
End With
With .Controls.Add(msoControlButton, 11726)
.Caption = "&Access"
End With
With .Controls.Add(msoControlButton, 11727)
.Caption = "&Text File"
End With
With .Controls.Add(msoControlButton, 11728)
.Caption = "XM&L File"
End With
With .Controls.Add(msoControlButton, 11729)
.Caption = "&ODB&C Database"
End With
With .Controls.Add(msoControlButton, 11731)
.Caption = "&HTML Document"
End With
With .Controls.Add(msoControlButton, 11732)
.Caption = "d&BASE File"
End With
With .Controls.Add(msoControlButton, 626)
.Caption = "&Word Merge"
End With
End With
' Start a new group.
cmbControl.BeginGroup = True
End With
Set cmbControl = Nothing
Set cmbRightClick = Nothing
End Sub