|
可以解决,方法是用类模块,通过判断Ctrl.Tag 或Caption来实现.在另一类模块中写入菜单生成. '类名为CCommandButtonEvent Option Explicit
Private WithEvents wobjCommandBarButton As Office.CommandBarButton '用动态的方法才是正解,因为不支持OnAction 有时会有两次按钮事件出现
Private Sub wobjCommandBarButton_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error GoTo err_Handler Select Case Ctrl.Tag
Case "Turn Off Auto Backup-Save"
Call TimerStop
Case "Turn On Auto Backup-Save"
Call TimerStart
Case "Open Backup Folder"
Call OpenBackupFolder
Case "Backup Options"
Call ShowOptions
Case "Product Website"
Call GettingStartedBackup
Case Else End Select
Exit Sub
err_Handler:
MsgBox Err.Description, vbCritical + vbOKOnly, C_AppName
End Sub
Friend Function AddFromBar(ByVal oCommanddBarPopup As CommandBarControl) As Object
On Error Resume Next
Set wobjCommandBarButton = oCommanddBarPopup.Controls.Add(Type:=msoControlButton)
Set AddFromBar = wobjCommandBarButton
End Function
菜单生成类. CMenu Option Explicit
Private objOpenedButtonEvents() As CCommandButtonEvent
Private CBC As CommandBarControl Sub MakeMenuBackup() Dim CB As CommandBar
Dim objOpenedButtons() As Office.CommandBarButton
Dim q As String
Dim q1 As String
Dim txt As String
Dim txt1 As String
Dim X, x1 As Variant
Dim I As Long On Error Resume Next
xlApp.Application.ScreenUpdating = False DeleteMenuBackup
Set CB = xlApp.CommandBars("Menu Bar") 'this is constant
Set CBC = CB.Controls.Add(Type:=msoControlPopup, temporary:=False)
With CBC
On Error Resume Next
If GetSetting(SoftName, C_AppName, "On") = True Then
.Caption = "Backup" & " (On)"
Else
.Caption = "Backup" & " (Off)"
End If q = "Turn Off Auto Backup-Save[split]Turn On Auto Backup-Save[split]Open Backup Folder[split]Backup Options[split]Product Website"
txt = q
Debug.Print q
X = Split(txt, "[split]") q1 = "342[split]343[split]23[split]548[split]1576" '取得FaceId
txt1 = q1
Debug.Print q1
x1 = Split(txt1, "[split]")
'Debug.Print UBound(X)
'Debug.Print UBound(x1) ReDim objOpenedButtonEvents(UBound(X))
ReDim objOpenedButtons(UBound(X))
If GetSetting(SoftName, C_AppName, "On") = True Then
Set objOpenedButtonEvents(0) = New CCommandButtonEvent
Set objOpenedButtons(0) = objOpenedButtonEvents(0).AddFromBar(CBC)
objOpenedButtons(0).Tag = X(0)
objOpenedButtons(0).Caption = X(0)
objOpenedButtons(0).FaceId = x1(0)
Else
Set objOpenedButtonEvents(1) = New CCommandButtonEvent
Set objOpenedButtons(1) = objOpenedButtonEvents(1).AddFromBar(CBC)
objOpenedButtons(1).Tag = X(1)
objOpenedButtons(1).Caption = X(1)
objOpenedButtons(1).FaceId = x1(1)
End If
For I = 2 To UBound(X)
Set objOpenedButtonEvents(I) = New CCommandButtonEvent
Set objOpenedButtons(I) = objOpenedButtonEvents(I).AddFromBar(CBC)
objOpenedButtons(I).Tag = X(I)
objOpenedButtons(I).Caption = X(I)
objOpenedButtons(I).FaceId = x1(I)
Next I End With ' Erase objOpenedButtons xlApp.Application.ScreenUpdating = True
End Sub
Sub DeleteMenuBackup() ' Delete our menu items
Dim oCtl As CommandBarControl
On Error Resume Next
For Each oCtl In xlApp.CommandBars("Menu Bar").Controls
If oCtl.Caption = "Backup" & " (On)" Or oCtl.Caption = "Backup" & " (Off)" Then
oCtl.Delete
' Exit For
End If
Next oCtl
End Sub
nN4D1QFW.zip
(32.65 KB, 下载次数: 41)
| 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2006-7-31 22:24
楼主
发表于 2006-8-8 09:23
