Création d'un menu personnalisé qui appelle une macro

L'exemple de code suivant décrit comment créer un menu personnalisé avec quatre options de menu, dont chacune appelle une macro.

Exemple de code fourni par : Holy Macro! Books, Holy Macro! It’s 2 500 Excel VBA Examples

L'exemple de code suivant configure le menu personnalisé lorsque le classeur est ouvert, et le supprime lorsque le classeur est fermé.

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

Le menu « MyFunction » est ajouté lorsque le classeur est ouvert, et supprimé lorsque le classeur est fermé. Il fournit quatre options de menu, une macro étant affectée à chaque option. La fonction définie par l'utilisateur (FDU), « MyFunction », multiplie trois valeurs dans une plage et renvoie le résultat.

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

Saisie de formule: cette option de menu est affectée à la macro « Cbm_Active_Formula », qui appelle la FDU nommée « MyFunction » qui multiplie les nombres figurant dans les 3 cellules précédentes et stocke la valeur de la FDU dans la cellule active. La plage B6:D6 doit comporter des valeurs et vous devez sélectionner la cellule E6 avant de cliquer sur cette option de menu.

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

Saisie de valeur: cette option de menu est affectée à la macro « Cbm_Active_Value », qui insère la valeur générée par la FDU nommée « MyFunction » dans la cellule active. La plage B6:D6 doit comporter des valeurs et vous devez sélectionner la cellule E6 avant de cliquer sur cette option de menu.

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

Sélection de formule: cette option de menu est affectée à la macro « Cbm_Formula_Select », qui utilise une méthode InputBox afin que l'utilisateur puisse sélectionner la plage à calculer par la FDU « MyFunction ». La valeur renvoyée par la FDU est stockée dans la cellule active.

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

Sélection de valeur: cette option de menu est affectée à la macro « Cbm_Value_Select », qui utilise une méthode InputBox afin que l'utilisateur puisse sélectionner la plage à calculer par la FDU « MyFunction ». La valeur est directement stockée dans la cellule active, plutôt que renvoyée par la FDU.

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

À propos du collaborateur

Holy Macro! Books publie des livres divertissants pour les personnes qui utilisent Microsoft Office. Vous pouvez consulter le catalogue complet sur MrExcel.com.

Assistance et commentaires

Avez-vous des questions ou des commentaires sur Office VBA ou sur cette documentation ? Consultez la rubrique concernant l’assistance pour Office VBA et l’envoi de commentaires afin d’obtenir des instructions pour recevoir une assistance et envoyer vos commentaires.