VBA实用小程序11：通过右键快捷菜单导航工作簿和工作表

下面的VBA程序在单元格快捷菜单中添加一个名为“工作簿导航”的命令，通过该命令快速地在当前所有打开的工作簿及其工作表之间导航，如图1所示。

图1

 

在VBE中添加一个标准模块，输入下面的代码：

Sub CustomMenu()

    On ErrorGoTo ExitSub:

    Dim cmb AsCommandBarControl

    On ErrorResume Next

   Application.CommandBars('Cell').Controls('工作簿导航').Delete

    Set cmb =Application.CommandBars('Cell').Controls.Add _

                   (Type:=msoControlPopup, Temporary:=True)

    cmb.Caption= '工作簿导航'

   cmb.OnAction = 'AddControlsInCustomMenu'

ExitSub:

    Exit Sub

End Sub

 

Sub AddControlsInCustomMenu()

    Dim wb AsWorkbook

    Dim ws AsWorksheet

    Dim cmb AsCommandBarControl

    DimcmbCtl1  As CommandBarControl, cmbCtl2 AsCommandBarControl

   

    For Eachcmb In Application.CommandBars('Cell'). _

                                   Controls('工作簿导航').Controls

        OnError Resume Next

       cmb.Delete

    Next

   

    For Eachwb In Application.Workbooks

        Set cmbCtl1= Application.CommandBars('Cell'). _

          Controls('工作簿导航').Controls.Add(Type:=msoControlPopup)

        WithcmbCtl1

           .Caption = wb.Name

           .OnAction = 'ActivateWB'

        EndWith

        ForEach ws In wb.Sheets

            If ws.Visible = xlSheetVisible Then

               Set cmbCtl2 = cmbCtl1.Controls.Add( _

                                 Type:=msoControlButton)

               With cmbCtl2

                   .Caption = ws.Name

                   .OnAction = 'ActivateWS'

               End With

           End If

        Nextws

    Next wb

End Sub

 

Sub ActivateWB()

    On ErrorResume Next

   Windows(Application.CommandBars.ActionControl.Caption).Activate

End Sub

 

Sub ActivateWS()

    On ErrorResume Next

    Sheets(Application.CommandBars.ActionControl.Caption).Activate

End Sub

 

在ThisWorkbook模块中，输入下面的代码：

Private Sub Workbook_Open()

    On ErrorResume Next

   Application.CommandBars('Cell').Controls('工作簿导航').Delete

    CallCustomMenu

End Sub

 

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    On ErrorResume Next

   Application.CommandBars('Cell').Controls('工作簿导航').Delete

End Sub