先要看效果是不是满足要求啊,源码上传
Option Explicit
Private WithEvents xlApp As Excel.Application
'Note: No error handling is implemented in the example.
'Only the usual references are used for the project, i e Office 12 and Excel 12.
'In order to customize the Ribbon UI the IRibbonExtensibility must be implemented.
Implements IRibbonExtensibility
Dim MailRib As IRibbonUI
Private Sub AddinInstance_OnConnection(ByVal Application As Object, _
ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
'The variable xlApp is declared in a standard module.
Set xlApp = Application
End Sub
Private Sub AddinInstance_OnDisconnection _
(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
'Release the object from memory.
Set xlApp = Nothing
End Sub
Public Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String
'Parse the XML to the Ribbon.
IRibbonExtensibility_GetCustomUI = LoadResString(101)
End Function
'Callback for customUI.onLoad
Sub RibbonOnLoad(ribbon As IRibbonUI)
Set MailRib = ribbon
End Sub
'Callback for data1 getEnabled
' 由工具Custom UI Editor for Microsoft Office 2010产生的回调申明为:
' Sub EnabledIRibbonA(control As IRibbonControl, ByRef returnedVal)
' 这个适用于VBA,用于COM中时要进行修改
Function EnabledIRibbonA(control As IRibbonControl) As Boolean
EnabledIRibbonA = Not IsEmpty(xlApp.ActiveSheet.UsedRange)
End Function
'Callback for data1 onAction
Sub IRibbonA(control As IRibbonControl)
MsgBox "OK"
End Sub
'Callback for data2 onAction
Sub IRibbonB(control As IRibbonControl)
MsgBox "OK"
End Sub
' 工作表激活事件,当工作表激活时确定按钮是否可用
Private Sub xlApp_SheetActivate(ByVal Sh As Object)
On Error Resume Next
RedoMailRib
End Sub
Sub RedoMailRib()
On Error Resume Next
MailRib.Invalidate
End Sub
Customize RibbonX UI.rar
(8.9 KB, 下载次数: 39)
|