Erstellen eines benutzerdefinierten Menüs, das ein Makro aufruft

Der folgende Beispielcode beschreibt, wie ein benutzerdefiniertes Menü mit vier Menüoptionen erstellt wird, von denen jede ein Makro aufruft.

Beispielcode bereitgestellt von: Holy Macro! Books, Holy Macro! It's 2,500 Excel VBA Examples

Im folgenden Codebeispiel wird das benutzerdefinierte Menü eingerichtet, wenn die Arbeitsmappe geöffnet wird, und das Menü wird gelöscht, wenn die Arbeitsmappe geschlossen wird.

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

Das Menü "MyFunction" wird hinzugefügt, wenn die Arbeitsmappe geöffnet wird, und gelöscht, wenn die Arbeitsmappe gelöscht wird.eted when the workbook closes. Es bietet vier Menüoptionen, und jeder Option ist ein Makro zugewiesen. Die benutzerdefinierte Funktion (UDF) "MyFunction" multipliziert drei Werte in einem Bereich und gibt das Ergebnis zurück.

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

Formeleingabe: Dieser Menüoption ist das Makro "Cbm_Active_Formula" zugewiesen, das die UDF mit dem Namen "MyFunction" aufruft, die die Zahlen in der vorhergehenden drei Zellen multipliziert und den Wert der UDF in der aktiven Zelle speichert. Im Bereich B6:D6 müssen Werte vorhanden sein, und Sie müssen die Zelle E6 auswählen, bevor Sie auf diese Menüoption klicken.

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

Werteingabe: Dieser Menüoption ist das Makro "Cbm_Active_Value" zugewiesen, das den von der UDF mit dem Namen "MyFunction" generierten Wert in die aktive Zelle eingibt. Im Bereich B6:D6 müssen Werte vorhanden sein, und Sie müssen die Zelle E6 auswählen, bevor Sie auf diese Menüoption klicken.

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

Formelauswahl: Diese Menüoption ist dem Makro "Cbm_Formula_Select" zugewiesen, das ein InputBox verwendet, in dem der Benutzer den Bereich auswählen kann, den die UDF "MyFunction" berechnen soll. Der Rückgabewert der UDF wird in der aktiven Zelle gespeichert.

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

Wertauswahl: Diese Menüoption ist dem Makro "Cbm_Value_Select" zugewiesen, das ein InputBox verwendet, in dem der Benutzer den Bereich auswählen kann, den die UDF "MyFunction" berechnen soll. Der Wert wird direkt in der aktiven Zelle gespeichert und nicht von der UDF zurückgegeben.

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

Über den Autor

Holy Macro! Books veröffentlicht unterhaltsame Bücher für Benutzer von Microsoft Office. Den kompletten Katalog finden Sie unter MrExcel.com.

Support und Feedback

Haben Sie Fragen oder Feedback zu Office VBA oder zu dieser Dokumentation? Unter Office VBA-Support und Feedback finden Sie Hilfestellung zu den Möglichkeiten, wie Sie Support erhalten und Feedback abgeben können.