【VBA】独自のメニューバー/右クリックメニューを設定する
<機能>
(1)独自のメニューバー(コマンドバー)を設定します
[アドイン](メニュー)
[備忘録サンプル](オリジナル)
緑でフォームを表示
ピンクでフォームを表示
(2)コマンドバーはワークブックオープンで生成、クローズで破棄されます
(3)独自の右クリックメニュー(セル右クリックメニュー)を設定します
(4)下記メニュー機能を実装します
緑でフォームを表示(MainShow1プロシージャコール)
ピンクでフォームを表示(MainShow2プロシージャコール)
(5)フォームの表示位置を保持します
<動作検証&開発環境>
Microsoft Office2016
<実行イメージ>
アドインメニューに独自メニューを設定します
セルを右クリックすると独自メニューが表示されます
[緑でフォームを表示]をクリックするとMainShow1がコールされます
[ピンクでフォームを表示]をクリックするとMainShow2がコールされます
<使い方>
(1)[挿入]メニューからユーザフォームを挿入します
※名前はUserForm1(デフォルト名)とします
(2)[挿入]メニューから標準モジュールを挿入します
※名前はModule1(デフォルト名)とします
(3)ユーザフォーム(UserForm1)にボタンコントロールを貼り付けます
※名前はbtnClose、キャプションを「閉じる」とします
(4)ソースを貼り付けます
’ThisWorkbook(OpenとBeforeCloseイベント処理追加)
'/********************************************************
'/* ワークブックオープンでメニューバーを作成
'/********************************************************
Private Sub Workbook_Open()
Dim wkstr As String
'メニューバーの作成
Call Module1.CreateMenu
'ポップアップメニューの作成
Call Module1.CreatePopUp
'フォームの初期表示位置はエクセルアプリケーションの左上
Module1.XPOS = Application.Left
Module1.YPOS = Application.Top
'先頭シートのA1選択
ThisWorkbook.Sheets(1).Select
Range("A1").Select
End Sub
'/********************************************************
'/* ワークブッククローズでメニューバーを削除
'/********************************************************
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim objCB As CommandBar
Set objCB = Application.CommandBars("Worksheet Menu Bar")
'メニューバーが作成済みであれば削除する
On Error Resume Next
objCB.Controls(Module1.CAP_MAIN).Delete
objCB = Nothing
End Sub
’Module1(定数定義と独自メニュー生成処理を追加)
'//フォームの表示位置を保持
Public XPOS As Integer
Public YPOS As Integer
Public Const CAP_MAIN = "備忘録サンプル"
Public Const MENU1 = "緑でフォームを表示"
Public Const MENU2 = "ピンクでフォームを表示"
'/********************************************************
'/* メニューバー(アドインメニュー)の作成
'/********************************************************
Public Sub CreateMenu()
Dim objCB As CommandBar
Dim CmdCtrl As CommandBarControl
Dim CmdBtn1 As CommandBarButton, CmdBtn2 As CommandBarButton
Set objCB = Application.CommandBars("Worksheet Menu Bar")
'作成済みであれば削除
On Error Resume Next
objCB.Controls(CAP_MAIN).Delete
On Error GoTo 0
Set CmdCtrl = CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, Temporary:=True)
CmdCtrl.Caption = CAP_MAIN
Set CmdBtn1 = CmdCtrl.Controls.Add(Type:=msoControlButton)
CmdBtn1.Caption = MENU1
CmdBtn1.OnAction = "MainShow1"
Set CmdBtn2 = CmdCtrl.Controls.Add(Type:=msoControlButton)
CmdBtn2.Caption = MENU2
CmdBtn2.OnAction = "MainShow2"
End Sub
'/********************************************************
'/* ポップアップメニュー(右クリックメニュー)の作成
'/********************************************************
Public Sub CreatePopUp()
Dim CmdBar As CommandBar
Dim CmdBtn1 As CommandBarButton, CmdBtn2 As CommandBarButton
Set CmdBar = CommandBars("Cell")
CmdBar.Reset
Set CmdBtn1 = CmdBar.Controls.Add(msoControlButton, Temporary:=True)
CmdBtn1.BeginGroup = True
CmdBtn1.Caption = MENU1
CmdBtn1.OnAction = "MainShow1"
Set CmdBtn2 = CmdBar.Controls.Add(msoControlButton, Temporary:=True)
CmdBtn2.BeginGroup = True
CmdBtn2.Caption = MENU2
CmdBtn2.OnAction = "MainShow2"
Set CmdBar = Nothing
Set CmdBtn1 = Nothing
Set CmdBtn2 = Nothing
End Sub
'/********************************************************
'/* メニュー画面の表示
'/* MENU1からコールされた場合はMainShow1
'/* MENU2からコールされた場合はMainShow2
'/********************************************************
Public Sub MainShow1()
'フォームのキャプション変更
UserForm1.Caption = Module1.MENU1
'メニュー画面の背景色を設定
UserForm1.BackColor = RGB(169, 208, 142)
UserForm1.btnClose.BackColor = RGB(169, 208, 142)
'メニュー画面表示
UserForm1.Show vbModal
End Sub
Public Sub MainShow2()
'フォームのキャプション変更
UserForm1.Caption = Module1.MENU2
'メニュー画面の背景色を設定
UserForm1.BackColor = RGB(255, 178, 255)
UserForm1.btnClose.BackColor = RGB(255, 178, 255)
'メニュー画面表示
UserForm1.Show vbModal
End Sub
'UserForm1(表示位置の設定、Clickイベント)
'/********************************************************
'/* フォームの表示位置を指定
'/********************************************************
Private Sub UserForm_Activate()
Application.ScreenUpdating = False
Me.Left = Module1.XPOS
Me.Top = Module1.YPOS
Application.ScreenUpdating = True
End Sub
'/********************************************************
'/* [閉じる]ボタン押下時の処理
'/********************************************************
Private Sub btnClose_Click()
Unload Me
End Sub
'/********************************************************
'/* フォームを閉じるときの処理
'/********************************************************
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Module1.XPOS = Me.Left
Module1.YPOS = Me.Top
'[x]ボタンで閉じれなくする
If CloseMode = vbFormControlMenu Then
Cancel = True
End If
End Sub
よろしければポチッと押してください