Question : Creating Menu's with Macro's and Supressing Pertinent Options in Code

My questions has two parts:
1. How to create a menu using macro's.
2. How to dynamically suppress or disable options on that menu using VBA code in the Current Event of a From.

I want to create a menu that will come up when a user right clicks on specific line of a continuous form. For example purposes say continuous form name is 'frmOrders' and each line on the form contain information pertaining to an order for a client. The right click menu will be called 'OrderOptions' (which I would like to build with a macro will have options such as:
View Client Address Record
Send Late Notice
Mark as Paid
Re-Print Original Invoice

I will set up frmOrders' to have 'OrderOptions' specified as the ShortcutMenuBar

Depending on the specific line the user is on, certain options are not pertinent and I don't want the user to see them when the righ click menu comes up. For example if the order has been paid in full there is no reason for the user to see the options 'Send Late Notice' or 'Mark as Paid'.

I envision code in the in the current event of the form such as the following (Pseudo code):
Private Sub Form_Current()
if me.status=paidinfull
suppress option 'Send Late Notice' in Menu 'OrderOptions'
suppress option 'Mark as Paid' in Menu 'OrderOptions'
else
show option 'Send Late Notice' in Menu 'OrderOptions'
show option 'Mark as Paid' in Menu 'OrderOptions'
endif
end sub

any suggestions?

Answer : Creating Menu's with Macro's and Supressing Pertinent Options in Code

You can build custom popup menus that will respond to right click events:

http://www.vb123.com/Toolshed/05_map/ch07_rightclickmenu.htm

As to customizing - you work with shortcut menus the same as any other menu. Here's a good site for starters:
http://jamiessoftware.tk/articles/menubars.html

You would NOT do this in the Current event of the form, but instead in whatever event you use to invoke the menu ... so if you add code to the Click event of whatever control/section you want to show the menu.

The code below shows one method for doing this. In order to use this code, you'd need a reference to the Microsoft Office xx Library (where xx is the version you're working with). Obviously this is specific to an applicaiton of mine, but hopefully it will show you how to work with those things.

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:

           
           
             Function fncMenuDefaults()
 
 '/Purpose:
 '/Created: 3/1/2005 09:11 AM
 '/Created By: Scott
  
  Dim cbrReports    As CommandBarPopup
  Dim cbrSetup      As CommandBarPopup
  Dim cbr           As CommandBar
  Dim cbrWO         As CommandBarPopup
  Dim cbrPrb        As CommandBarPopup
  Dim cbrHelp       As CommandBarPopup
  Dim cbrEvents     As CommandBarPopup
  Dim cbrWOFilters  As CommandBarPopup
  Dim cbrPRFilters  As CommandBarPopup
  Dim cbrAddWO      As CommandBarPopup
  Dim blnQA         As Boolean
  
  On Error GoTo Err_fncMenuDefaults
  
  Set cbr = CommandBars("WorkOrders")
  Set cbrWO = cbr.Controls("Work Orders")
  Set cbrPrb = cbr.Controls("Problems")
  Set cbrReports = cbr.Controls("Reports")
  Set cbrSetup = cbr.Controls("Setup && Utilities")
  Set cbrHelp = cbr.Controls("Help")
  Set cbrEvents = cbrWO.Controls("Add\Remove Events")
  Set cbrWOFilters = cbrWO.Controls("Filter Work Orders")
  Set cbrPRFilters = cbrPrb.Controls("Filter Problems")
  Set cbrAddWO = cbrWO.Controls("Add New Work Order")
  
  '/don't really care about errors here ...
  On Error Resume Next
  
  blnQA = IsUserQA
 
    With cbrReports
      .Controls("Open Excel").Visible = False
      .Controls("Email This Report").Visible = False
      .Controls("Close This Report").Visible = False
      .Controls("Configuration").Visible = False
      .Controls("Quick Reports").Visible = False
    End With
  
    With cbrSetup
      .Enabled = True
      .Controls("Program Setup").Enabled = blnQA
      .Controls("Print Blank Forms").Visible = False
      .Controls("Email Application Problem").Visible = False
      .Controls("Relink Tables").Enabled = blnQA
    End With
  
    With cbrEvents
      .Controls("At The End").Visible = False
      .Controls("At The Beginning").Visible = False
    End With
  
    With cbrWO
      .Controls("Void This Work Order").Visible = False
      .Controls("Delete This Work Order").Visible = False
      .Controls("Global Search ...").Visible = False
      .Controls("Save As Template").Visible = False
      .Controls("Find WorkOrder123:").Visible = False
    End With
  
  cbrWOFilters.Controls("From Saved Search").Visible = False
  
  cbrAddWO.Controls("From Template").Visible = False
  
    With cbrPrb
      .Controls("Delete This Problem").Visible = False
      .Controls("View Associated Work Order").Visible = True
      .Controls("Global Search").Visible = False
    End With
  
  cbrPRFilters.Controls("From Saved Search").Visible = False
      
  cbrHelp.Controls("WOA Custom Help").Visible = False
 
Exit_fncMenuDefaults:
  On Error Resume Next
  Set cbrReports = Nothing
  Set cbrSetup = Nothing
  Set cbr = Nothing
  Set cbrWO = Nothing
  Set cbrPrb = Nothing
  Set cbrHelp = Nothing
  Set cbrEvents = Nothing
  Set cbrWOFilters = Nothing
  Set cbrPRFilters = Nothing
  Set cbrAddWO = Nothing
  Exit Function
  
Err_fncMenuDefaults:
    Select Case Err
      'case
      Case Else
        MsgBox Err & ":" & Error$, vbCritical, "basMenuFunctions" & ": " & "fncMenuDefaults"
    End Select
  
  Resume Exit_fncMenuDefaults
 
End Function

           
         

Open in New Window

Select All