VBA*CommandBars在工具欄上添加下拉列表框


在Excel工作表的菜單中可以添加新的菜單項和子菜單,如下面的代碼所示。

Sub myTools()
    Dim myTools As CommandBarPopup
    Dim myCap As Variant
    Dim myid As Variant
    Dim i As Byte
    myCap = Array("基礎應用", "VBA程序開發", "函數與公式", "圖表與圖形", "數據透視表")
    myid = Array(281, 283, 285, 287, 292)
    With Application.CommandBars("Worksheet menu bar")
        .Reset
        Set myTools = .Controls("幫助(&H)").Controls.Add(Type:=msoControlPopup, Before:=1)
        With myTools
            .Caption = "Excel Home 技術論壇"
            .BeginGroup = True
            For i = 1 To 5
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = myCap(i - 1)
                    .FaceId = myid(i - 1)
                    .OnAction = "myC"
            End With
            Next
        End With
    End With
    Set myTools = Nothing
End Sub

代碼解析:
myTools過程使用Add方法在Excel工作表菜單欄中的“幫助”菜單中添加一個標題為“Excel Home 技術論壇”的菜單項和5個子菜單。
第2行到第5行代碼聲明變量類型。
第6、7行代碼使用Array函數創建兩個數組用於保存子菜單的名稱和圖標ID。
第9行代碼,在添加菜單項前先使用Reset方法重置菜單欄以免重復添加菜單項。Reset方法重置一個內置控件,恢復該控件原來對應的動作,並將各屬性恢復成初始狀態,語法如下:
expression.Reset
參數expression 是必需的,返回一個命令欄或命令欄控件對象。
第10行代碼,使用Add方法在Excel工作表菜單欄中的“幫助”菜單中添加菜單項。Add方法應用於CommandBarControls對象時,新建一個CommandBarControl對象並添加到指定命令欄上的控件集合,語法如下:
expression.Add(Type, Id, Parameter, Before, Temporary)
參數expression 是必需的,返回一個CommandBarControls對象,代表命令欄中的所有控件。
參數Type是可選的,添加到指定命令欄的控件類型,可以為表格 79 1所列的MsoControlType常數之一。

常數 值 控件類型
msoControlButton 1 命令按鈕
msoControlEdit 2 文本框
msoControlDropdown 3 下拉列表控制框
msoControlComboBox 4 下拉組合控制框
msoControlPopup 10 彈出式控件
表格 79 1 MsoControlType常數
因為在本例中將添加的是帶有子菜單的菜單項,所以將參數Type設置為彈出式控件。
參數Id是可選的,標識整數。如果將該參數設置為 1或者忽略,將在命令欄中添加一個空的指定類型的自定義控件。
參數Parameter是可選的,對於內置控件,該參數用於容器應用程序運行命令。對於自定義控件,可以使用該參數向Visual Basic過程傳遞信息,或用其存儲控件信息。
參數Before是可選的,表示新控件在命令欄上位置的數字。新控件將插入到該位置控件之前。如果忽略該參數,控件將添加到指定命令欄的末端。本例中將Before參數設置為1,菜單項添加到“幫助”菜單的頂端。
參數Temporary是可選的。設置為True將使添加的菜單項為臨時的,在關閉應用程序時刪除。默認值為False。
第12行代碼,設定新添加菜單項的Caption屬性為“Excel Home 技術論壇”。Caption屬性返回或設置命令欄控件的標題。
第13行代碼,設置新添加菜單項的BeginGroup屬性為True,分組顯示。
第14行到第19行代碼,在“Excel Home 技術論壇”菜單項上添加五個子菜單並設置其Caption屬性、FaceId屬性和OnAction屬性。
FaceId屬性設置出現在菜單標題左側的圖標,以數字表示,一個數字代表一個內置的圖標。

OnAction屬性設置一個VBA的過程名,該過程在用戶單擊子菜單時運行,本例中設置為下面的過程。

Public Sub myC()
    MsgBox "您選擇了: " & Application.CommandBars.ActionControl.Caption
End Sub
代碼解析:
myC過程是單擊新添加子菜單所運行過程,為了演示方便在這里只使用MsgBox函數顯示所其Caption屬性。

刪除新添加的菜單項及子菜單的代碼如下所示。

Sub DelmyTools()
    Application.CommandBars("Worksheet menu bar").Reset
End Sub
代碼解析:
DelmyTools過程使用Reset方法重置菜單欄,刪除添加的菜單項及子菜單。
為了在打開工作簿時自動添加菜單項,需要在工作簿的Activate事件中調用myTools過程,如下面的代碼所示。
Private Sub Workbook_Activate()
    Call myTools
End Sub
為了在關閉工作簿時刪除新添加的菜單項,還需要在工作簿的Deactivate事件中調用DelmyTools過程,如下面的代碼所示。
Private Sub Workbook_Deactivate()
    Call DelmyTools
End Sub
如果希望這個菜單為所有工作簿使用,那么就應該在工作簿的Open事件中調用myTools過程,在BeforeClose事件中調用DelmyTools過程。
運行myTools過程,將在Excel工作表菜單欄中的“幫助”菜單中添加一個名為“Excel Home 技術論壇”的菜單項及五個子菜單,如圖 79 1所示。

圖 79 1    在“幫助”菜單中添加菜單項及子菜單

技巧80 在菜單欄指定位置添加菜單

除了可以在工作表菜單中添加菜單項外,還可以在工作表菜單欄的指定位置添加菜單,如下面的代碼所示。

Sub AddNewMenu()
    Dim HelpMenu As CommandBarControl
    Dim NewMenu As CommandBarPopup
    With Application.CommandBars("Worksheet menu bar")
        .Reset
        Set HelpMenu = .FindControl(ID:=.Controls("幫助(&H)").ID)
        If HelpMenu Is Nothing Then
            Set NewMenu = .Controls.Add(Type:=msoControlPopup)
        Else
            Set NewMenu = .Controls.Add(Type:=msoControlPopup, _
                Before:=HelpMenu.Index)
        End If
        With NewMenu
            .Caption = "統計(&S)"
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "輸入數據(&D)"
                .FaceId = 162
                .OnAction = ""
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "匯總數據(&T)"
                .FaceId = 590
                .OnAction = ""
            End With
        End With
    End With
    Set HelpMenu = Nothing
    Set NewMenu = Nothing
End Sub
代碼解析:
AddNewMenu過程使用Add方法在工作表“幫助”菜單前添加一個標題為“統計”的菜單和兩個菜單項。
第6行代碼,使用FindControl方法在工作表菜單欄中查找“幫助”菜單。應用於CommandBars對象的FindControl方法返回一個符合指定條件的CommandBarControl對象。語法如下:
expression.FindControl(Type, Id, Tag, Visible, Recursive)
參數expression是必需的,返回一個CommandBars對象。
參數Type是可選的,要查找控件的類型。
參數Id是可選的,要查找控件的標識符。
參數Tag是可選的,要查找控件的標記值。
參數Visible是可選,如果該值為True,那么只查找屏幕上顯示的命令欄控件。默認值為False。
參數Recursive是可選的,如果該值為True,那么將在命令欄及其全部彈出式子工具欄中查找。此參數僅應用於CommandBar對象。默認值為False。
如果沒有控件符合搜索條件,那么FindControl方法返回Nothing。
第7行到第12行代碼,如果工作表菜單欄中存在“幫助”菜單,將“統計”菜單添加到“幫助”菜單之前,否則添加到工作表菜單欄末尾。
第12行到第25行代碼,在“統計”菜單中添加兩個子菜單並設置其各種屬性。
運行AddNewMenu過程,將在工作表菜單欄的“幫助”菜單之前添加一個“統計”菜單,如圖 80 1所示。

圖 80 1    在工作表菜單欄中添加菜單

技巧81 屏蔽和刪除工作表菜單

如果不希望用戶使用工作表菜單欄的部分功能,可以把菜單或菜單項屏蔽或刪除,如下面的代碼所示。

Sub Shibar()
    With Application.CommandBars("Worksheet menu bar")
        .Reset
        .Controls("工具(&T)").Controls("宏(&M)").Enabled = False
        .Controls("數據(&D)").Delete
    End With
End Sub
代碼解析:
Shibar過程屏蔽 “工具”菜單中的“宏”菜單項,刪除菜單欄中的“數據”菜單。
第3行代碼,使用Reset方法重置工作表菜單欄。
第4行代碼,將“宏”菜單項的Enabled屬性設置為False,使之無效。
Enabled屬性決定命令欄或命令欄控件是否激活,如果將該屬性設置為 False,那么該菜單項將無效。
第5行代碼,使用Delete方法將“數據”菜單從工作表菜單欄中刪除。
Delete方法應用於命令欄或命令欄控件時,從集合中刪除指定對象,語法如下:
expression.Delete(Temporary)
參數expression是必需的,返回命令欄或命令欄控件對象之一。
參數Temporary是可選的,設置為True將從當前會話中刪除控件,應用程序在下次會話時將再次顯示控件。
運行Shibar過程,將屏蔽工作表“工具”菜單中的“宏”菜單項和刪除工作表菜單欄中的“數據”菜單,如圖 81 1所示。

圖 81 1    屏蔽和刪除工作表菜單

技巧82 改變系統菜單的操作

利用VBA甚至可以改變系統菜單的默認操作,使之達到自定義菜單的效果,如下面的代碼所示。

Dim WithEvents Saveas As CommandBarButton
Private Sub Workbook_Open()
    Set Saveas = Application.CommandBars("File").Controls("另存為(&A)...")
End Sub
Private Sub Saveas_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    CancelDefault = True
    MsgBox "本工作簿禁止另存!"
End Sub
代碼解析:
第1行代碼,在模塊級別中使用關鍵詞WithEvents聲明變量Saveas是用來響應由CommandBarButton對象觸發事件的對象變量。
第2行到第4代碼工作簿的Open事件過程,在工作簿打開時將變量Saveas賦值為系統菜單的“另存為”菜單。
因為在聲明變量Saveas時使用了關鍵詞WithEvents,不能同時使用New關鍵詞隱式地創建對象,所以在使用變量Saveas之前,必須使用Set語句將變量賦值為一個已有對象。
第5行到第8代碼變量Saveas的單擊事件過程,改變系統菜單“另存為”的默認操作。
變量Saveas的Click事件在用戶單擊系統菜單“另存為”時發生,語法如下:
Private Sub CommandBarButton_Click(ByVal Ctrl As CommandBarButton,
    ByVal CancelDefault As Boolean)
參數Ctrl是必需的,指示初始化該事件的CommandBarButton控件。
參數CancelDefault是必需的,Boolean類型,如果執行了與CommandBarButton控件關聯的默認操作,該值為False。除非其他過程或加載項取消了此操作。
第6、7行代碼,將CancelDefault參數設置為True,使單擊“另存為”菜單時並不執行默認操作而只顯示一個消息框。
將工作簿保存、關閉后,重新打開,單擊“另存為”菜單並不執行默認操作,只顯示一個消息框,如圖 82 1所示。

圖 82 1 改變系統菜單的默認操作

技巧83 定制自己的系統菜單

使用VBA開發的小型應用系統完成后,Excel原有的菜單欄完全可以舍棄不用,只使用自定義的菜單欄,更加方便快捷,如下面的代碼所示。

Sub AddNowBar()
    Dim NewBar As CommandBar
    On Error Resume Next
    With Application
        .CommandBars("Standard").Visible = False 
        .CommandBars("Formatting").Visible = False 
        .CommandBars("Stop Recording").Visible = False
        .CommandBars("toolbar list").Enabled = False
        .CommandBars.DisableAskAQuestionDropdown = True
        .DisplayFormulaBar = False 
        .CommandBars("NewBar").Delete
    End With
    Set NewBar = Application.CommandBars.Add(Name:="NewBar", Position:=msoBarTop, MenuBar:=True, Temporary:=True)
    With NewBar
        .Visible = True
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "系統設置(&X)"
            .BeginGroup = True
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "保存(&S)"
                .BeginGroup = True
                .FaceId = 1975
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "備份(&B)"
                .BeginGroup = True
                .FaceId = 747
            End With
        End With
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "會計憑證(&P)"
            .BeginGroup = True
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "錄入(&L)"
                .BeginGroup = True
                .FaceId = 197
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "審核(&S)"
                .BeginGroup = True
                .FaceId = 714
            End With
        End With
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "會計賬簿(&Z)"
            .BeginGroup = True
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "記賬(&L)"
                .BeginGroup = True
                .FaceId = 65
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "結賬(&S)"
                .BeginGroup = True
                .FaceId = 47
            End With
        End With
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "會計報表(&B)"
            .BeginGroup = True
            With .Controls.Add(Type:=msoControlPopup)
                .Caption = "資產負債表(&Y)"
                .BeginGroup = True
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = "月報(&M)"
                    .BeginGroup = True
                    .FaceId = 1180
                End With
                    With .Controls.Add(Type:=msoControlButton)
                        .Caption = "年報(&Y)"
                        .BeginGroup = True
                        .FaceId = 1188
                    End With
                End With
            With .Controls.Add(Type:=msoControlPopup)
                .Caption = "損益表(&S)"
                .BeginGroup = True
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = "月報(&M)"
                    .BeginGroup = True
                    .FaceId = 1180
                End With
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = "年報(&Y)"
                    .BeginGroup = True
                    .FaceId = 1188
                End With
            End With
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "退出系統(&C)"
            .BeginGroup = True
            .Style = msoButtonCaption
        End With
    End With
    Set NewBar = Nothing
End Sub
代碼解析:
AddNowBar過程使用Add方法創建自定義菜單欄替換工作表菜單欄。
第2行代碼定義變量NwBar為命令欄。
第3行代碼忽略錯誤語句,以免第11行代碼在刪除可能不存在的“NewBar”菜單欄時發生錯誤。
第5行代碼隱藏“常用”工具欄。
第6行代碼隱藏“格式”工具欄。
第7行代碼隱藏“停止錄制”工具欄。
第8行代碼屏蔽工具欄的右鍵快捷菜單。
第9行代碼屏蔽工具欄的“鍵入需要幫助的問題”下拉框。
第10行代碼屏蔽工具欄的編輯欄。
第11行代碼,在添加命令欄前先刪除“NewBar”菜單欄,以免重復增加。
第13行代碼,使用Add方法創建命令欄。Add方法應用於CommandBars對象的語法如下:
expression.Add(Name, Position, MenuBar, Temporary)
參數expression是必需的,返回一個CommandBars對象,該對象代表應用程序中的命令欄,新建命令欄的控件均以該對象為載體。
參數Name是可選的,設置新建命令欄的標題。如果忽略該參數,則為新建命令欄指定默認標題,本例中設置新建命令欄的標題為“NewBar”。
參數Position是可選的,設置新建命令欄的位置或類型,可以為表格 83 1所列的 MsoBarPosition常數之一。
常數    說明
msoBarLeft、msoBarTop、msoBarRight 和 msoBarBottom    指定新命令欄的左側、頂部、右側和底部坐標
msoBarFloating    指定新命令欄不固定
msoBarPopup    指定新命令欄為快捷菜單
msoBarMenuBar    僅適用於 Macintosh 機
表格 83 1    MsoBarPosition 常數
本例中設置“NewBar”命令欄的Position參數為msoBarTop,使“NewBar”命令欄位於Excel窗口的頂部。
參數MenuBar是可選的,設置為True 將以新命令欄替換活動菜單欄,默認值為False。
在本例中,設置“NewBar”命令欄的MenuBar屬性為True,以“NewBar”命令欄替換活動菜單欄。
參數Temporary是可選的,設置為True將使新建命令欄為臨時命令欄,在關閉應用程序時刪除,默認值為False。
在本例中,設置“NewBar”命令欄的Temporary屬性為True,使“NewBar”命令欄為臨時命令欄,在關閉應用程序時刪除。
第15行代碼,設置“NewBar”命令欄為可見的。
第16行到95行代碼,使用Add方法在“NewBar”命令欄中添加菜單、菜單項及子菜單並設置其各項屬性,參閱技巧79 。

恢復Excel原有的菜單欄的代碼如下:

Sub DelNowBar()
    On Error Resume Next
    With Application
        .CommandBars("Standard").Visible = True
        .CommandBars("Formatting").Visible = True
        .CommandBars("Stop Recording").Visible = True
        .CommandBars("toolbar list").Enabled = True
        .CommandBars.DisableAskAQuestionDropdown = False
        .DisplayFormulaBar = True
        .CommandBars("NewBar").Delete
    End With
End Sub
代碼解析:
DelNowBar過程取消 “常用”、“格式”和“停止錄制”工具欄的的隱藏,恢復“鍵入需要幫助的問題”下拉框和編輯欄,刪除“NewBar”命令欄。
運行AddNowBar過程,工作表菜單欄如圖 83 1所示。

圖 83 1    定制自己的系統菜單

技巧84 改變菜單按鈕圖標

利用VBA可以改變系統菜單的默認圖標,使之達到自定義按鈕圖標的效果,如下面的代碼所示。

Sub myCbarCnt()
    Dim myCbarCnt As CommandBarControl
    With Sheet1.Shapes.AddShape(17, 1000, 1000, 30, 30)
        .Fill.ForeColor.SchemeColor = 29
        .CopyPicture
        .Delete
    End With
    Set myCbarCnt = Application.CommandBars("Standard").Controls(1)
    myCbarCnt.PasteFace
    Set myCbarCnt = Nothing
End Sub
Sub DelmyCbarCnt()
    Application.CommandBars("Standard").Controls(1).Reset
End Sub
代碼解析:
myCbarCnt過程改變系統菜單的“新建”按鈕的圖標。
第3行代碼使用Shape對象的AddShape方法在工作表中新建一個自選圖形。應用於Shape對象的AddShape方法請參閱技巧53 。
在本例中將新建圖形的Left參數和Top參數設置為較大的數值使新建的自選圖形不在當前窗口的可視區域內。
第4行代碼設置新建自選圖形的顏色。
第5行代碼使用CopyPicture方法將新建自選圖形作為圖片復制到剪貼板。CopyPicture方法的語法如下:
expression.CopyPicture(Appearance, Format)
參數expression是必需的,一個有效的對象。
參數Appearance是可選的,指定圖片的復制方式。
參數Format是可選的,圖片的格式。
第6行代碼使用Delete方法刪除新建的自選圖形。
第8行代碼使用Set語句將系統菜單的“新建”按鈕賦給變量myCbarCnt。
第9行代碼PasteFace方法將新建的自選圖形粘貼到“新建”按鈕中。PasteFace方法將“剪貼板”的內容粘貼到指定命令欄按鈕控件上,語法如下:
expression.PasteFace
參數expression是必需的,返回一個CommandBarButton對象。
DelmyCbarCnt過程使用Reset方法恢復“新建”按鈕的默認圖標。
運行myCbarCnt過程結果如圖 84 1所示。

圖 84 1    改變“新建”按鈕的圖標

技巧85 右鍵快捷菜單增加菜單項

在Excel的右鍵快捷菜單中可以添加新的菜單項,如下面的代碼所示。

Sub MyCmb()
    Dim MyCmb As CommandBarButton
    With Application.CommandBars("Cell")
        .Reset
        Set MyCmb = .Controls.Add(Type:=msoControlButton, _
            ID:=2521, Before:=.Controls.Count, Temporary:=True)
            MyCmb.BeginGroup = True
        End With
    Set MyCmb = Nothing
End Sub
代碼解析:
MyCmb過程使用Add方法在Excel的右鍵快捷菜單中添加內置的“打印”菜單項。
在使用Add方法添加菜單項時將Id參數設置為2521,添加的就是內置的“打印”菜單項。將Before屬性設置成右鍵快捷菜單中最后一個控件的值,使“打印”菜單項添加到右鍵快捷菜單中最后一個控件之前。將Temporary參數設置成True,在關閉應用程序時從右鍵快捷菜單中刪除“打印”菜單項。
運行MyCmb過程,將在Excel右鍵快捷菜單中添加 “打印”菜單項,如圖 85 1所示

圖 85 1    在右鍵快捷菜單中添加菜單項

技巧86 自定義右鍵快捷菜單

在工作表中創建自定義的右鍵快捷菜單替換Excel默認的右鍵快捷菜單,如下面的代碼所示。

Sub Mycell()
    With Application.CommandBars.Add("Mycell", msoBarPopup)
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "會計憑證"
            .FaceId = 9893
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "會計賬簿"
            .FaceId = 284
        End With
        With .Controls.Add(Type:=msoControlPopup)
            .Caption = "會計報表"
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "月報"
                .FaceId = 9590
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "季報"
                .FaceId = 9591
            End With
            With .Controls.Add(Type:=msoControlButton)
                .Caption = "年報"
                .FaceId = 9592
            End With
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "憑證打印"
            .FaceId = 9614
            .BeginGroup = True
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "賬簿打印"
            .FaceId = 707
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "報表打印"
            .FaceId = 986
        End With
    End With
End Sub
代碼解析:
Mycell過程在Excel工作表中創建自定義的右鍵快捷菜單。
第2行代碼,使用Add方法添加名稱為“Mycell”命令欄,設置“Mycell”命令欄的Position屬性為msoBarPopup,使“Mycell”命令欄為快捷菜單。關於Position參數的MsoBarPosition常數請參閱技巧83 中的表格 83 1。
第3行到第39行代碼,使用Add方法在“Mycell”命令欄中添加菜單和菜單項,並設置其各項屬性。

為了讓自定義右鍵快捷菜單替換Excel默認的右鍵快捷菜單,並且只在右鍵單擊Sheet1工作表時顯示,需要在Sheet1工作表的BeforeRightClick事件中寫入下面的代碼。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Application.CommandBars("Mycell").ShowPopup
    Cancel = True
End Sub
代碼解析:
工作表的BeforeRightClick事件過程,在右鍵單擊工作表時,將“Mycell”命令欄作為右鍵快捷菜單,在當前光標位置顯示。
工作表BeforeRightClick事件語法如下:
Private Sub expression_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
參數expression是必需的,Worksheet類型對象。
參數Target 是可選的,右鍵單擊發生時最靠近鼠標指針的單元格。
參數Cancel是可選的,當事件發生時為False。如果在事件過程中將Cancel參數設為True,則該過程執行結束之后不進行默認的右鍵單擊操作。
第2行代碼,使用ShowPopup方法將“Mycell”命令欄作為右鍵快捷菜單,在當前光標位置顯示。
ShowPopup方法的語法如下:
expression.ShowPopup(x, y)
參數expression是必需的,返回一個CommandBar對象。
參數x是可選的,快捷菜單所在位置的 x 坐標。如果省略此參數,將使用當前光標位置的x坐標。
參數y是可選的,快捷菜單所在位置的y坐標。如果省略此參數,將使用當前光標位置的y坐標。
當用鼠標右鍵單擊工作表中任意單元格時激活BeforeRightClick事件,此事件先於默認的右鍵單擊操作。在使用ShowPopup方法顯示“Mycell”命令欄后,將Cancel參數設置為True,過程執行結束之后不進行默認的右鍵單擊操作,Excel右鍵快捷菜單就不會顯示。
運行Mycell過程后,右鍵單擊Sheet1工作表,在工作表中顯示自定義右鍵快捷菜單,如圖 86 1所示。

技巧87 使用右鍵菜單制作數據有效性

在工作表中輸入數據時可以使用自定義右鍵菜單制作數據有效性,如下面的代碼所示。

Sub Mycell()
    Dim arr As Variant
    Dim i As Integer
    Dim Mycell As CommandBar
    On Error Resume Next
    Application.CommandBars("Mycell").Delete
    arr = Array("經理室", "辦公室", "生技科", "財務科", "營業部")
    Set Mycell = Application.CommandBars.Add("Mycell", 5)
    For i = 0 To 4
        With Mycell.Controls.Add(1)
            .Caption = arr(i)
            .OnAction = "MyOnAction"
        End With
    Next
End Sub
Sub MyOnAction()
    ActiveCell = Application.CommandBars.ActionControl.Caption
End Sub
代碼解析:
Mycell過程創建自定義的右鍵菜單,請參閱技巧86 。
MyOnAction過程是點擊自定義右鍵菜單所運行的過程,將所選右鍵菜單的名稱寫入活動單元格。

為了使自定義的右鍵菜單在Sheet1工作表的特定區域中顯示,需要在VBE中雙擊Sheet1表后寫入下面的代碼。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 2 Then
        Call Mycell
        Application.CommandBars("Mycell").ShowPopup
        Cancel = True
    End If
End Sub
代碼解析:
工作表的BeforeRightClick事件過程,在右鍵單擊工作表時,將“Mycell”命令欄作為右鍵快捷菜單,在當前光標位置顯示,請參閱技巧86 。
在工作表的B列中點擊右鍵結果如圖 87 1所示。

技巧88 禁用工作表右鍵菜單

有時並不希望用戶使用工作表中的右鍵菜單對工作表進行操作,那么可以使用下面的代碼禁用工作表右鍵菜單。

Sub DisBar()
    Dim myBar As CommandBar
    For Each myBar In CommandBars
        If myBar.Type = msoBarTypePopup Then
            myBar.Enabled = False
        End If
    Next
End Sub
代碼解析:
DisBar過程禁用工作表中所有的右鍵菜單。
第3行代碼使用For Each...Next 語句遍歷CommandBars集合。CommandBars集合代表應用程序中所有的命令欄。
第4行代碼根據命令欄的Type屬性判斷命令欄是否為右鍵菜單。應用於 CommandBar對象的Type屬性返回命令欄的類型,可以為表格 88 1所列的MsoBarType 常量之一。

常量 值 描述
msoBarTypeMenuBar 1 菜單欄
msoBarTypeNormal 0 工具欄
msoBarTypePopup 2 右鍵快捷菜單
表格 88 1 MsoBarType 常量
第5行代碼將CommandBars集合中右鍵快捷菜的Enabled屬性設置為False,使之無效。
運行DisBar過程將禁用工作表中所有的右鍵菜單,需要恢復時只需將其Enabled屬性設置為True即可。

技巧89 創建自定義工具欄

為了方便用戶操作,在Excel原有的的工具欄上,還可以創建自定義的工具欄,如下面的代碼所示。

Sub NowToolbar()
    Dim arr As Variant
    Dim id As Variant
    Dim i As Integer
    Dim Toolbar As CommandBar
    On Error Resume Next
    Application.CommandBars("MyToolbar").Delete
    arr = Array("會計憑證", "會計賬簿", "會計報表", "憑證打印", "賬簿打印", "報表打印")
    id = Array(9893, 284, 9590, 9614, 707, 986)
    Set Toolbar = Application.CommandBars.Add("MyToolbar", msoBarTop)
        With Toolbar
            .Protection = msoBarNoResize
            .Visible = True
            For i = 0 To 5
                With .Controls.Add(Type:=msoControlButton)
                    .Caption = arr(i)
                    .FaceId = id(i)
                    .BeginGroup = True
                    .Style = msoButtonIconAndCaptionBelow
                End With
            Next
        End With
    Set Toolbar = Nothing
End Sub
代碼解析:
NowToolbar過程使用Add方法在Excel窗口中創建自定義工具欄。應用於CommandBars對象的Add方法請參閱技巧83 。
第10行代碼,使用Add方法在菜單欄上創建名稱為“MyToolbar”的命令欄,創建時設置新命令欄的Position參數為msoBarTop,使新命令欄位於應用程序窗口的頂部。如果將Position參數設置成msoBarFloating,新命令欄為浮動工具欄,如圖 89 1所示。

圖 89 1    浮動命令欄
關於Position參數的MsoBarPosition常數請參閱技巧83 中的表格 83 1。
第12行代碼,設置“MyToolbar”命令欄的Protection屬性為msoBarNoResize。應用於CommandBar對象的Protection屬性指定命令欄的保護類型,可以為表格 89 1所列的MsoBarProtection常數之一。

常數 值 說明
msoBarNoProtection 0 不受保護,可自定義(缺省值)
msoBarNoCustomize 1 不能自定義
msoBarNoResize 2 不能調整大小
msoBarNoMove 4 不能移動
msoBarNoChangeVisible 8 不能更改可見狀態
msoBarNoChangeDock 16 不能改變停靠的位置
msoBarNoVerticalDock 32 不能沿窗口左側或右側停放
msoBarNoHorizontalDock 64 不能沿窗口頂部或底部停放
表格 89 1 MsoBarProtection常數
第14行到第21代碼,使用Add方法在新命令欄中添加按鈕控件,設置按鈕控件的各項屬性。其中第19行代碼,設置按鈕控件的Style屬性為msoButtonIconAndCaptionBelow,使工具欄按鈕顯示時包含圖標和標題,且標題位於圖標之下。
應用於CommandBar對象的Style屬性返回或設置工具欄按鈕的顯示方式,可以為表格 89 2所列的MsoButtonStyle常數之一。
常數 值 說明
msoButtonIcon 1 包含圖標的按鈕
msoButtonCaption 2 包含標題的按鈕
ButtonIconandCaption 3 包含圖標和標題的按鈕
msoButtonIconAndCaptionBelow 11 包含圖標和標題,且標題位於底部的按鈕
msoButtonIconAndWrapCaption 7 包含圖標和標題,且標題自動換行的按鈕
msoButtonWrapCaption 14 包含標題,且標題自動換行的按鈕
表格 89 2 MsoButtonStyle常數
運行NowToolbar過程,將在Excel窗口的頂部創建一個自定義的工具欄,如圖 89 2所示。

圖 89 2 創建自定義工具欄

技巧90 自定義工具欄按鈕圖標

在創建自定義的工具欄時,除了可以為工具欄按鈕添加Excel內置的圖標外,還能為工具欄按鈕添加自定義的圖標,如下面的代碼所示。

Sub AddCustomButton()
    Dim xBar As CommandBar
    Dim xButton As CommandBarButton
    On Error Resume Next
    Application.CommandBars("CustomBar").Delete
    Set xBar = CommandBars.Add("CustomBar", msoBarTop)
    Set xButton = xBar.Controls.Add(msoControlButton)
    With xButton
        .Picture = LoadPicture(ThisWorkbook.Path & "\P.BMP")
        .Mask = LoadPicture(ThisWorkbook.Path & "\M.BMP")
        .TooltipText = "Excel Home 論壇"
    End With
    xBar.Visible = True
    Set xBar = Nothing
    Set xButton = Nothing
End Sub
代碼解析:
AddCustomButton過程創建自定義工具欄,並設置工具欄的按鈕自定義圖標。
第6、7行代碼,使用Add方法在Excel窗口中添加自定義工具欄和按鈕。請參閱技巧89 。
第9行代碼,設置工具欄按鈕的Picture屬性為同一目錄中的p.bmp圖片。
應用於CommandBarButton 對象的Picture屬性返回一個IPictureDisp對象,表示 CommandBarButton對象的圖像,語法如下:
expression.Picture
參數是必需的,返回一個CommandBarButton對象。
指定對象的Picture屬性就能設置對象的圖像。
第10行代碼,設置工具欄按鈕的Mask屬性為同一目錄中的m.bmp圖片。
為了使工具欄按鈕圖標透明顯示,在指定對象的Picture屬性后,還需要指定對象的Mask屬性。
應用於CommandBarButton 對象的Mask屬性返回表示CommandBarButton對象的屏蔽圖像的IPictureDisp對象,語法如下:
expression.Mask
參數是必需的,返回一個CommandBarButton對象。
屏蔽圖像決定按鈕圖像透明的部分。在創建作為屏蔽圖像使用的圖像時,所有要透明的區域應該為白色,所有要顯示的區域應該為黑色。
第11行代碼,設置按鈕的“屏幕提示”為“ExcelHome論壇”。
運行AddCustomButton過程,創建自定義工具欄,並設置工具欄按鈕的圖標,如圖 90 1所示。

圖 90 1    自定義工具欄圖標

技巧91 自定義工作簿圖標

Excel標題欄的圖標是默認的,而借助API函數可以自定義工作簿標題欄圖標,如下面的代碼所示。

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Private Const WM_SETICON = &H80
Private Sub Workbook_Open()
    Dim IStyle As Long
    Dim hIcon As Long
    Dim hWndForm As Long
    hWndForm = FindWindow(vbNullString, Application.Caption)
    hIcon = ExtractIcon(0, ActiveWorkbook.Path & "\p.bmp", 0)
    SendMessage hWndForm, WM_SETICON, True, hIcon
    SendMessage hWndForm, WM_SETICON, False, hIcon
End Sub
代碼解析:
工作簿打開后使用API函數自定義工作簿標題欄的圖標。
第1行到第6行代碼,API函數聲明。
第7行到第15行代碼,工作簿的Open事件過程,把工作簿標題欄默認的圖標更改為同一文件夾下的p.bmp圖片。
工作簿打開后標題欄如圖 91 1所示,任務欄圖標如圖 91 2所示。

圖 91 1    自定義工作簿標題和圖標

圖 91 2    任務欄圖標

技巧92 移除工作表的最小最大化和關閉按鈕

如果不希望工作表的最小、最大化和關閉按鈕出現在菜單欄中,可以使用以下代碼去除:
ActiveWorkbook.Protect , , True
代碼解析:
使用Protect方法對工作簿進行保護。Protect方法應用於Workbook對象的時保護工作簿使其不至被修改,語法如下:
expression.Protect(Password, Structure, Windows)
參數expression是必需的,該表達式返回一個Workbook對象。
參數Password是可選的,為工作表或工作簿指定區分大小寫的密碼。
參數Structure是可選的,如果為True,則保護工作簿結構(工作表的相對位置)。默認值為False。
參數Windows是可選的,如果為True,則保護工作簿窗口。
恢復工作表的最大、最小化和關閉按鈕的代碼如下:
ActiveWorkbook.Protect , , False
在本例中將Windows參數設置為True,使工作簿窗口受到保護,工作表的最小、最大化和關閉按鈕及圖標不出現在菜單欄中,如圖 92 1所示。

圖 92 1 移除工作表最小、最大化和關閉按鈕

技巧93 在工具欄上添加下拉列表框

如果需要在工具欄中添加類似“字體”這樣的下拉列表控制框控件,那么可以使用下面的代碼。

Sub AddDropdown()
    Dim myDropdown As Object
    Dim myCap As Variant
    Dim i As Integer
    myCap = Array("基礎應用", "VBA程序開發", "函數與公式")
    Call DeleteButton
    Set myDropdown = Application.CommandBars("Formatting").Controls _
        .Add(Type:=msoControlDropdown, Before:=1)
    With myDropdown
        .Caption = "請選擇版塊"
        .OnAction = "myOnA"
        .Style = msoComboNormal
        For i = 0 To UBound(myCap)
            .AddItem myCap(i)
        Next
        .ListIndex = 1
    End With
End Sub
Sub DeleteButton()
    With Application.CommandBars("Formatting").Controls(1)
        If .Caption = "請選擇版塊" Then .Delete
    End With
End Sub
Sub myOnA()
    Dim myList As Byte
    myList = Application.CommandBars("Formatting") _
        .Controls(1).ListIndex
    ActiveWorkbook.FollowHyperlink _
    Address:="http://club.excelhome.net/forum-" & myList & "-1.html", NewWindow:=True
End Sub
代碼解析:
AddDropdown過程使用Add方法在工具欄中添加下拉列表控制框控件。
第5行代碼使用Array函數創建一個數組用於保存下拉列表控制框控件加載列表項所需的元素。
第6行代碼先運行第19行到第23行的DeleteButton過程刪除可能存在的下拉列表控制框控件,以免重復添加。DeleteButton過程判斷工具欄中第一個控件的Caption屬性是否為“請選擇版塊”,如果是則刪除該下拉列表控制框控件。
第7、8行代碼使用Add方法在工具欄中添加下拉列表控制框控件。應用於 CommandBarControls 對象的Add方法請參閱技巧79 。示例中將其參數Type設置為msoControlDropdown,添加的就是下拉列表控制框控件。
第10行代碼設置下拉列表控制框控件的Caption屬性,應用於 CommandBarControls 對象的Caption屬性返回或設置指定命令欄控件的題注文字,也可作為默認的“屏幕提示”顯示。
第11行代碼設置改變下拉列表控制框控件的內容時要運行的過程為第24行到第30行代碼的myOnA過程。myOnA過程根據下拉列表控制框控件的ListIndex屬性值打開Excel Home論壇中相應的版塊。
第12行代碼設置下拉列表控制框控件的樣式。Style屬性返回或設置命令欄控件的顯示方式,該屬性值可設置為表格 93 1所列MsoComboStyle常量之一。
常量    值    描述
msoComboLabel    1    顯示標簽
msoComboNormal    0    不顯示標簽
表格 93 1    MsoComboStyle常量
第13行到第15行代碼使用AddItem方法將數組中的元素添加到下拉列表控制框控件的列表項中。
第16行代碼將下拉列表控制框控件的ListIndex屬性設置為1,使其顯示第一條列表項。
運行AddDropdown過程,工具欄如圖 93 1所示。

圖 93 1    添加下拉列表控制框控件

技巧94 屏蔽工作表的復制功能

有時我們並不希望用戶對工作表中的數據進行復制粘貼操作,此時可以把所有的復制功能都屏蔽,如下面的代碼所示。

    Dim CmdCtrls As CommandBarControls
    Dim Cmd As CommandBarControl
Sub ProCopy()
    Set CmdCtrls = Application.CommandBars.FindControls(ID:=19)
    For Each Cmd In CmdCtrls
        Cmd.Enabled = False
    Next
    Application.CellDragAndDrop = False
    Application.OnKey ("^c"), ""
End Sub
Sub StaCopy()
    Set CmdCtrls = Application.CommandBars.FindControls(ID:=19)
    For Each Cmd In CmdCtrls
        Cmd.Enabled = True
    Next
    Application.CellDragAndDrop = True
    Application.OnKey ("^c")
End Sub
代碼解析:
第1、2行代碼在模塊頂部聲明兩個模塊級的變量。
第3行到第10行代碼ProCopy過程,屏蔽工作表中所有的復制功能。其中第4行到第7行代碼使用FindControls方法將所有與“復制”相關的命令欄控件賦給變量CmdCtrls后將其Enabled設置為False。關於FindControls方法請參閱技巧80 。
第8行代碼屏蔽單元格拖放功能,關於應用於Application對象的CellDragAndDrop屬性請參閱技巧10 。
第9行代碼屏蔽<Ctrl+C>組合鍵功能,關於應用於Application 對象的OnKey方法請參閱技巧68 。
第11行到第18行代碼StaCopy過程,恢復所有的復制功能。
### 技巧95     禁用工具欄的自定義
在Excel中,用戶可以通過依次單擊菜單“視圖”→“工具欄”→“自定義”,顯示“自定義”選項卡來調整菜單欄和工具欄,如圖 95 1、圖 95 2所示。

圖 95 1    自定義功能

圖 95 2    自定義選項卡

如果不希望用戶使用“自定義”選項卡來調整菜單欄和工具欄,可以禁用工具欄的自定義功能,如下面的代碼所示。

Sub nCustomize()
    Application.CommandBars.DisableCustomize = True
End Sub
代碼解析:
nCustomize 過程禁用工具欄的自定義功能,應用於CommandBars 集合對象的DisableCustomize屬性設置是否禁用工具欄的自定義。如果禁用,返回True,否則返回False。
用於啟用工具欄的自定義的代碼是:
Sub yCustomize()
    Application.CommandBars.DisableCustomize = False
End Sub
運行nCustomize過程,禁用工具欄的自定義對話框,自定義菜單項消失,如圖 95 3所示。

圖 95 3    禁用工具欄的自定義

技巧96 屏蔽所有的命令欄

在使用自定義的操作界面時,需要屏蔽Excel中所有的命令欄,可以使用下面的代碼。

Sub Shielding_1()
    Dim i As Integer
    For i = 1 To Application.CommandBars.Count
        Application.CommandBars(i).Enabled = False
    Next
End Sub
代碼解析:
Shielding_1過程使用For...Next語句遍歷Excel命令欄,並將其Enabled屬性設置為False,使之無效。\

還可以使用For Each…Next 語句遍歷所有的CommandBars對象,代碼如下:

Sub Shielding_2()
    Dim Cmd As CommandBar
    For Each Cmd In Application.CommandBars
        Cmd.Enabled = False
    Next
End Sub
運行Shielding_1或Shielding_2過程工作簿如圖 96 1所示。

圖 96 1 屏蔽所有的命令欄
在需要恢復時只需將Enabled屬性設置為True即可,如下面的代碼所示。

Sub Recovery_1()
    Dim i As Integer
    For i = 1 To Application.CommandBars.Count
        Application.CommandBars(i).Enabled = True
    Next
End Sub
Sub Recover_2()
    Dim Cmd As CommandBar
    For Each Cmd In Application.CommandBars
        Cmd.Enabled = True
    Next
End Sub
代碼解析:
Recovery_1和Recover_2過程分別使用For...Next語句和For Each...Next 語句遍歷所有的CommandBars對象,設置其Enabled屬性為True,顯示所有的命令欄。

技巧97 恢復Excel的命令欄

如果用戶經常添加、刪除Excel的菜單和工具欄而又沒有及時恢復的話,有時會破壞Excel默認的用戶界面,即使用Reset方法也不能恢復成初始狀態。
此時可以在電腦的本地硬盤中查找擴展名為.xlb的文件,該文件在電腦中的位置會因Excel版本的不同而不同,在XP操作系統中,該文件位於系統盤的Documents and Settings\Administrator\Application Data\Microsoft\Excel文件夾,其中Administrator是電腦的用戶名。找到它最簡單的方法是使用Windows的搜索功能。按<Win+F>組合鍵調出Windows的搜索窗口,然后用.xlb為目標在本地硬盤中進行搜索,如圖 97 1所示。

圖 97 1 搜索*.xlb文件
如果搜索沒有結果,請檢查“更多高級選項”中是否選中“搜索隱藏的文件和文件夾”選項,如圖 97 2所示。

圖 97 2 搜索隱藏的文件和文件夾
對Excel用戶界面的任何修改都會保存在.xlb文件中,找到后刪除該文件,然后重新啟動Excel。Excel會重新創建一個.xlb文件,而菜單和工具欄也會全部恢復成初始狀態。


免責聲明!

本站轉載的文章為個人學習借鑒使用,本站對版權不負任何法律責任。如果侵犯了您的隱私權益,請聯系本站郵箱yoyou2525@163.com刪除。



 
粵ICP備18138465號   © 2018-2025 CODEPRJ.COM