Excel（VBA）自定义右键单击菜单以启动宏(示例代码)_excel宏菜单范例

主要介绍 Excel（VBA）自定义右键单击菜单以启动宏(示例代码)以及相关的经验技巧

1. THISWORKBOOK (paste into ThisWorkbook, macros that open and closed menus when launching and closing spreadsheet)

3. Private Sub Workbook_Open()

4. MsgBox "You can right-click any worksheet cell" & vbCrLf & _

5. "to see and / or run your workbook's macros.", 64, "A tip:"

6. Run "RightClickReset"

7. Run "MakeMenu"

8. End Sub

10. Private Sub Workbook_Activate()

11. Run "RightClickReset"

12. Run "MakeMenu"

13. End Sub

15. Private Sub Workbook_Deactivate()

16. Run "RightClickReset"

17. End Sub

19. Private Sub Workbook_BeforeClose(Cancel As Boolean)

20. Run "RightClickReset"

21. ThisWorkbook.Save

22. End Sub

24. 'DEMONSTRATIONMACROS (paste into module DemonstrationMacros, macros you want to launch from the custom menu, these are examples)

26. Sub Macro1()

27. MsgBox "This is Macro1.", 64, "Test 1"

28. End Sub

30. Private Sub Macro2()

31. MsgBox "This is Macro2.", 64, "Test 2"

32. End Sub

34. Sub Macro3()

35. MsgBox "This is Macro3.", 64, "Test 3"

36. End Sub

38. 'MAINTENANCEMACROS (paste into module MaintenanceMacros, macros for creation and running of custom menu)

40. Private Sub RightClickReset()

41. On Error Resume Next

42. CommandBars("Cell").Controls("Macro List").Delete

43. Err.Clear

44. CommandBars("Cell").Reset

45. End Sub

47. Private Sub MakeMenu()

48. Run "RightClickReset"

49. Dim objCntr As CommandBarControl, objBtn As CommandBarButton

50. Dim strMacroName$

51. Set objCntr = _

52. Application.CommandBars("Cell").Controls.Add(msoControlPopup, before:=1)

53. objCntr.Caption = "Macro List"

54. Application.CommandBars("Cell").Controls(2).BeginGroup = True

55. Dim intLine%, intArgumentStart%, strLine$, objComponent As Object

56. For Each objComponent In ActiveWorkbook.VBProject.VBComponents

57. If objComponent.Type = 1 Then

58. For intLine = 1 To objComponent.CodeModule.CountOfLines

59. strLine = objComponent.CodeModule.Lines(intLine, 1)

60. strLine = Trim$(strLine) 'Remove indented spaces

61. If Left$(strLine, 3) = "Sub" Or Left$(strLine, 11) = "Private Sub" Then

62. intArgumentStart = InStr(strLine, "()")

63. If intArgumentStart > 0 Then

64. If Left$(strLine, 3) = "Sub" Then

65. strMacroName = Trim(Mid$(strLine, 4, intArgumentStart - 4))

66. Else

67. strMacroName = Trim(Mid$(strLine, 12, intArgumentStart - 12))

68. End If

69. If strMacroName <> "RightClickReset" And strMacroName <> "MakeMenu" Then

70. If strMacroName <> "MacroChosen" Then

71. Set objBtn = objCntr.Controls.Add

72. With objBtn

73. .Caption = strMacroName

74. .Style = msoButtonIconAndCaption

75. .OnAction = "MacroChosen"

76. .FaceId = 643

77. End With

78. End If

79. End If

80. End If

81. End If

82. Next intLine

83. End If

84. Next objComponent

85. End Sub

87. Private Sub MacroChosen()

88. With Application

89. Run .CommandBars("Cell").Controls(1).Controls(.Caller(1)).Caption

90. End With

91. End Sub