マクロを呼び出すカスタム メニューを作成する

次のコード例では、それぞれがマクロを呼び出す 4 つのメニュー オプションを持つカスタム メニューを作成する方法を示します。

サンプル コードの提供元: Holy Macro! Books、「Holy Macro! It's 2,500 Excel VBA Examples」

次のコード例では、ブックが開かれた時にカスタム メニューを設定し、ブックが閉じられたときにカスタム メニューを削除します。

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" は、ブックが開くときに追加され、ブックが閉じるときに削除されます。 このメニューには、それぞれマクロが割り当てられた 4 つのメニュー オプションがあります。 ユーザー定義関数 (UDF) の "MyFunction" は、範囲内の 3 つの値を掛け合わせ、その結果を返します。

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

数式エントリ: このメニュー オプションにはマクロ "Cbm_Active_Formula" が割り当てられます。このマクロは、前の 3 つのセルの数値を乗算する "MyFunction" という名前の UDF を呼び出し、アクティブなセルに 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" が割り当てられます。ユーザーは、UDF "MyFunction" が計算する範囲を選択するために InputBox を使用します。 値は、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 のサポートおよびフィードバックを参照してください。