Function CommandBarIsExist(ByVal strName As String) As Boolean
'引用 OFFICE OBJECT Library
Dim b As CommandBar
CommandBarIsExist = False
For Each b In CommandBars
If b.Name = strName Then
CommandBarIsExist = True
Exit For
End If
Next
End Function
Public Function GetAllFaceID_1()
'将所有的 FACE 图片显示在几个工具栏中
'只要在自定义时显示工具栏即可
Dim b As CommandBar
Dim c As CommandBarControl
Dim p As CommandBarPopup
Dim p1 As CommandBarPopup
Dim strName As String
Dim cmbC As CommandBarComboBox
Dim cmbB As CommandBarButton
Dim i As Long
On Error Resume Next
'重新定义菜单项目
'Type 属性应用于 CommandBarButton、CommandBarComboBox、CommandBarControl 和 CommandBarPopup 对象的情形。
'返回命令栏控件的类型。MsoControlType 类型，只读。
'MsoControlType 可以为下列 MsoControlType 常量之一。
'msoControlActiveX
'msoControlAutoCompleteCombo
'msoControlButton
'msoControlButtonDropdown
'msoControlButtonPopup
'msoControlComboBox
'msoControlCustom
'msoControlDropdown '与 combo 的区别是只能单击下拉，不能修改
'msoControlEdit
'msoControlExpandingGrid
'msoControlGauge
'msoControlGenericDropdown
'msoControlGraphicCombo
'msoControlGraphicDropdown
'msoControlGraphicPopup
'msoControlGrid
'msoControlLabel
'msoControlLabelEx
'msoControlOCXDropdown
'msoControlPane
'msoControlPopup
'msoControlSpinner
'msoControlSplitButtonMRUPopup
'msoControlSplitButtonPopup
'msoControlSplitDropdown
'msoControlSplitExpandingGrid
'msoControlWorkPane
'On Error Resume Next
For i = 0 To 10000
If i Mod 1000 = 0 Then
strName = "cg tools" & i
If CommandBarIsExist(strName) = True Then
Set b = CommandBars.Item(strName)
b.Delete
End If
Set b = CommandBars.Add(Name:=strName, Position:=msoBarFloating, MenuBar:=False, Temporary:=True)
End If
Debug.Print i
Set cmbB = b.Controls.Add(msoControlButton, , , , True)
cmbB.Caption = i
cmbB.FaceId = i
DoEvents
Next
End Function
Public Function GetAllFaceID_2()
Dim b As CommandBar
Dim c As CommandBarControl
Dim p As CommandBarPopup
Dim p1 As CommandBarPopup
Dim strName As String
Dim cmbC As CommandBarComboBox
Dim cmbB As CommandBarButton
Dim i As Long
On Error Resume Next
strName = "cg tools"
If CommandBarIsExist(strName) = True Then
Set b = CommandBars.Item(strName)
b.Delete
End If
Set b = CommandBars.Add(Name:=strName, Position:=msoBarFloating, MenuBar:=False, Temporary:=True)
'重新定义菜单项目
'Type 属性应用于 CommandBarButton、CommandBarComboBox、CommandBarControl 和 CommandBarPopup 对象的情形。
'返回命令栏控件的类型。MsoControlType 类型，只读。
'MsoControlType 可以为下列 MsoControlType 常量之一。
'msoControlActiveX
'msoControlAutoCompleteCombo
'msoControlButton
'msoControlButtonDropdown
'msoControlButtonPopup
'msoControlComboBox
'msoControlCustom
'msoControlDropdown '与 combo 的区别是只能单击下拉，不能修改
'msoControlEdit
'msoControlExpandingGrid
'msoControlGauge
'msoControlGenericDropdown
'msoControlGraphicCombo
'msoControlGraphicDropdown
'msoControlGraphicPopup
'msoControlGrid
'msoControlLabel
'msoControlLabelEx
'msoControlOCXDropdown
'msoControlPane
'msoControlPopup
'msoControlSpinner
'msoControlSplitButtonMRUPopup
'msoControlSplitButtonPopup
'msoControlSplitDropdown
'msoControlSplitExpandingGrid
'msoControlWorkPane
'On Error Resume Next
For i = 0 To 10000
Debug.Print i
If i Mod 500 = 0 Then
Set p = b.Controls.Add(msoControlPopup, , , , True)
p.Caption = i
End If
If i Mod 25 = 0 Then
Set p1 = p.Controls.Add(msoControlPopup, , , , True)
p1.Caption = i
End If
Set cmbB = p1.Controls.Add(msoControlButton, , , , True)
cmbB.Caption = i
cmbB.FaceId = i
DoEvents
Next
End Function |
