用VBA代碼處理菜單和工具欄之四

字號(hào):

復(fù)制菜單和工具欄
    必需用VBA代碼才能復(fù)制現(xiàn)有的工具欄。你可以用Add方法創(chuàng)建一個(gè)和你要拷貝相同類型的工具欄,然后再用CommandBarControl對(duì)的Copy方法將源工具欄上的每一個(gè)命令按鈕復(fù)制到新工具欄上,下面的函數(shù)將是以這種方法實(shí)現(xiàn)復(fù)制工具欄:
    strOrigCBName參數(shù)是指被復(fù)制的源工具欄,strNewCBName參數(shù)指新工具欄的名稱,可選參數(shù)blnShowBar決定了新工具欄是否顯示出來(lái)。
    Function CBCopyCommandBar(strOrigCBName As String, _
     strNewCBName As String, _
     Optional blnShowBar As Boolean = False) As Boolean
     ' This procedure copies the command bar named in the strOrigCBName
     ' argument to a new command bar specified in the strNewCBName argument.
     Dim cbrOriginal As CommandBar
     Dim cbrCopy As CommandBar
     Dim ctlCBarControl As CommandBarControl
     Dim lngBarType As Long
     On Error GoTo CBCopy_Err
     Set cbrOriginal = CommandBars(strOrigCBName)
     lngBarType = cbrOriginal.Type
     Select Case lngBarType
     Case msoBarTypeMenuBar
     Set cbrCopy = CommandBars.Add(Name:=strNewCBName, Position:=msoBarMenuBar)
     Case msoBarTypePopup
     Set cbrCopy = CommandBars.Add(Name:=strNewCBName, Position:=msoBarPopup)
     Case Else
     Set cbrCopy = CommandBars.Add(Name:=strNewCBName)
     End Select
     ' Copy controls to new command bar.
     For Each ctlCBarControl In cbrOriginal.Controls
     ctlCBarControl.Copy cbrCopy
     Next ctlCBarControl
     ' Show new command bar.
     If blnShowBar = True Then
     If cbrCopy.Type = msoBarTypePopup Then
     cbrCopy.ShowPopup
     Else
     cbrCopy.Visible = True
     End If
     End If
     CBCopyCommandBar = True
    CBCopy_End:
     Exit Function
    CBCopy_Err:
     CBCopyCommandBar = False
     Resume CBCopy_End
    End Function
    注意:
     1.這個(gè)函數(shù)的strNewCBName參數(shù)不能和現(xiàn)有工具欄中同名;
     2.如果你復(fù)制一個(gè)彈出式菜單欄,并且設(shè)blnShowBar參數(shù)為TRUE,當(dāng)運(yùn)行這個(gè)函數(shù)時(shí),這個(gè)彈出式菜單欄將顯示在當(dāng)前鼠標(biāo)的位置,更多的關(guān)于顯示彈出式菜單欄的信息和描述請(qǐng)參閱Microsoft Office Visual Basic Reference Help 中的“顯示彈出式菜單欄”索引。