【VBA】独自のメニューバー/右クリックメニューを設定する

0

    <機能>

    (1)独自のメニューバー(コマンドバー)を設定します

     [アドイン](メニュー)

      [備忘録サンプル](オリジナル)  

       緑でフォームを表示

       ピンクでフォームを表示

    (2)コマンドバーはワークブックオープンで生成、クローズで破棄されます

    (3)独自の右クリックメニュー(セル右クリックメニュー)を設定します

    (4)下記メニュー機能を実装します

     緑でフォームを表示(MainShow1プロシージャコール)

     ピンクでフォームを表示(MainShow2プロシージャコール)

    (5)フォームの表示位置を保持します

     

    <動作検証&開発環境>
    Microsoft Office2016

     

    <実行イメージ>

    アドインメニューに独自メニューを設定します

    CommandBars,msoControlButton,Controls.Add,オリジナルメニュー,独自メニュー,コマンドバー削除

    セルを右クリックすると独自メニューが表示されます

    CommandBars,msoControlButton,Controls.Add,オリジナルメニュー,独自メニュー,,コマンドバー削除

    [緑でフォームを表示]をクリックするとMainShow1がコールされます

    ユーザフォーム,背景色,CommandBars,msoControlButton,Controls.Add,オリジナルメニュー,独自メニュー,

    [ピンクでフォームを表示]をクリックするとMainShow2がコールされます

    ユーザフォーム,背景色,CommandBars,msoControlButton,Controls.Add,オリジナルメニュー,独自メニュー,

     

    <使い方>

    (1)[挿入]メニューからユーザフォームを挿入します

    ※名前はUserForm1(デフォルト名)とします

    CommandBars,msoControlButton,Controls.Add,オリジナルメニュー,独自メニュー,

    (2)[挿入]メニューから標準モジュールを挿入します

    ※名前はModule1(デフォルト名)とします

    CommandBars,msoControlButton,Controls.Add,オリジナルメニュー,独自メニュー,

    (3)ユーザフォーム(UserForm1)にボタンコントロールを貼り付けます

    ※名前はbtnClose、キャプションを「閉じる」とします

    CommandBars,msoControlButton,Controls.Add,オリジナルメニュー,独自メニュー,

     

    (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
     

    よろしければポチッと押してください

    プログラマー ブログランキングへ



    selected entries

    categories


    プログラマー ブログランキングへ

    calendar

    S M T W T F S
       1234
    567891011
    12131415161718
    19202122232425
    262728293031 
    << March 2017 >>

    profile

    others

    mobile

    qrcode