创建调用宏的自定义菜单

2024-07-11 13:29| 来源: 网络整理| 查看: 265

创建调用宏的自定义菜单项目04/07/2023

以下代码示例演示如何创建带有四个菜单选项的自定义菜单，每个选项调用一个宏。

示例代码提供方：Holy Macro! Books 出版的 Holy Macro! It's 2,500 Excel VBA Examples（Holy Macro! 2,500 个 Excel VBA 示例）

当工作簿打开时，以下代码示例将设置自定义菜单，并在工作簿关闭时删除。

Option Explicit Private Sub Workbook_BeforeClose(Cancel As Boolean) With Application.CommandBars("Worksheet Menu Bar") On Error Resume Next .Controls("&MyFunction").Delete On Error GoTo 0 End With End Sub Private Sub Workbook_Open() Dim objPopUp As CommandBarPopup Dim objBtn As CommandBarButton With Application.CommandBars("Worksheet Menu Bar") On Error Resume Next .Controls("MyFunction").Delete On Error GoTo 0 Set objPopUp = .Controls.Add( _ Type:=msoControlPopup, _ before:=.Controls.Count, _ temporary:=True) End With objPopUp.Caption = "&MyFunction" Set objBtn = objPopUp.Controls.Add With objBtn .Caption = "Formula Entry" .OnAction = "Cbm_Active_Formula" .Style = msoButtonCaption End With Set objBtn = objPopUp.Controls.Add With objBtn .Caption = "Value Entry" .OnAction = "Cbm_Active_Value" .Style = msoButtonCaption End With Set objBtn = objPopUp.Controls.Add With objBtn .Caption = "Formula Selection" .OnAction = "Cbm_Formula_Select" .Style = msoButtonCaption End With Set objBtn = objPopUp.Controls.Add With objBtn .Caption = "Value Selection" .OnAction = "Cbm_Value_Select" .Style = msoButtonCaption End With End Sub

当工作簿打开时，将添加菜单“MyFunction”，并将在工作簿关闭时删除。它提供四个菜单选项，并向每个选项分配一个宏。用户定义的函数 (UDF)“MyFunction”将区域中的三个值相乘并返回结果。

Function MyFunction(rng As Range) As Double MyFunction = rng(1) * rng(2) * rng(3) End Function

公式输入：向此菜单选项分配了宏“Cbm_Active_Formula”，它将调用名为“MyFunction”的 UDF（它将前面 3 个单元格中的数字相乘）并将 UDF 的值存储在活动单元格中。必须在区域 B6:D6 中具有值并在单击此菜单选项前先选定单元格 E6。

Sub Cbm_Active_Formula() 'setting up the variables. Dim intLen As Integer, strRng As String 'Using the active cell, E6. With ActiveCell 'Check to see if the preceding offset has valid data, and if there are three values If IsEmpty(.Offset(0, -1)) Or .Column < 4 Then 'If the data is not valid, call MyFunction directly as a formula, but with no parameters. .Formula = "=MyFunction()" Application.SendKeys "{ENTER}" Else 'If the data is valid, create a range of the preceding 3 cells strRng = Range(Cells(.Row, .Column - 3), _ Cells(.Row, .Column - 1)).Address intLen = Len(strRng) 'Call MyFunction as a formula, with the range as the parameter. .Formula = "=MyFunction(" & strRng & ")" Application.SendKeys "{ENTER}" End If End With End Sub

值输入：向此菜单选项分配了宏“Cbm_Active_Value”，它将由名为“MyFunction”的 UDF 生成的值输入到活动单元格中。必须在区域 B6:D6 中具有值并在单击此菜单选项前先选定单元格 E6。

Sub Cbm_Active_Value() 'Set up the variables. Dim intLen As Integer, strRng As String 'Using the active cell, E6. With ActiveCell 'If there isn't enough room in the column, then send a warning. If .Column < 4 Then Beep MsgBox "The function can be used only starting from column D!" 'Otherwise, call MyFunction, using the range of the previous 3 cells. Else ActiveCell.Value = MyFunction(Range(ActiveCell.Offset(0, -3), _ ActiveCell.Offset(0, -1))) End If End With End Sub

公式所选内容：向此菜单选项分配了宏“Cbm_Formula_Select”，它使用用户的 InputBox 以选择 UDF“MyFunction”应计算的区域。 UDF 的返回值存储在活动单元格中。

Sub Cbm_Formula_Select() 'Set up the variables. Dim rng As Range 'Use the InputBox dialog to set the range for MyFunction, with some simple error handling. Set rng = Application.InputBox("Range:", Type:=8) If rng.Cells.Count 3 Then MsgBox "Length, width and height are needed -" & _ vbLf & "please select three cells!" Exit Sub End If 'Call MyFunction in the active cell, E6. ActiveCell.Formula = "=MyFunction(" & rng.Address & ")" End Sub

值所选内容：向此菜单选项分配了宏“Cbm_Value_Select”，它使用用户的 InputBox 以选择 UDF“MyFunction”应计算的区域。值直接存储在活动单元格中，而不是由 UDF 返回。

Sub Cbm_Value_Select() 'Set up the variables. Dim rng As Range 'Use the InputBox dialog to set the range for MyFunction, with some simple error handling. Set rng = Application.InputBox("Range:", Type:=8) If rng.Cells.Count 3 Then MsgBox "Length, width and height are needed -" & _ vbLf & "please select three cells!" Exit Sub End If 'Call MyFunction by value using the active cell, E6. ActiveCell.Value = MyFunction(rng) End Sub 关于参与者

Holy Macro! Books 主要出版娱乐书籍，供使用 Microsoft Office 的人员阅读。有关完整目录，请访问 MrExcel.com。

支持和反馈

有关于 Office VBA 或本文档的疑问或反馈？请参阅 Office VBA 支持和反馈，获取有关如何接收支持和提供反馈的指南。

【本文地址】

公司简介

联系我们