用VB6.0制作Excel2010功能区COM加载项及自定义图标

henrylam

直接将XML代码写在“Connect”项会有行继续标志限制，因此可以将XML代码写到资源文件中，操作方法如下：
1.先用记事本编写好用于自定义功能区的XML代码；
2.到VB6.0菜单栏“工具”中，打开“资源编辑器”，新建或选中文件，点击“acb”打开“编辑字符串表”，然后将XML代码复制、粘贴到“101”右边框中，保存即可；

3.在“Connect”项编写调用代码。

1. Option Explicit
   
2. Implements IRibbonExtensibility '添加对 IRibbonExtensibility 接口的引用
   
3. Public xlApp As Excel.Application
   
4. 
   
5. Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
   
6.     Set xlApp = Application '加载时
   
7. End Sub
   
8. 
   
9. Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
   
10.     Set xlApp = Nothing '卸载时
    
11. End Sub
    
12. 
    
13. '调用资源文件中的XML代码用于自定义功能区
    
14. Public Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String
    
15.     IRibbonExtensibility_GetCustomUI = LoadResString(101)
    
16. End Function
    
17. 
    
18. 'Button1用的是系统内置图标，无需调用。Button2和Button3用的是自定义图标
    
19. Function GetImage(control As IRibbonControl) As IPictureDisp
    
20.     Select Case control.Id
    
21.     Case "Button2"
    
22.         Set GetImage = LoadResPicture(101, vbResBitmap) '调用资源文件中的位图作为功能区的图标
    
23.     Case "Button3"
    
24.         Set GetImage = LoadResPicture(102, vbResBitmap)
    
25.     End Select
    
26. End Function
    
27. 
    
28. '下面是测试控件回调的3个过程，对应3个按钮
    
29. Public Sub test1(ByVal control As IRibbonControl)
    
30.     MsgBox "测试通过，按钮用的是内置图标", vbInformation
    
31. End Sub
    
32. 
    
33. Public Sub test2(ByVal control As IRibbonControl)
    
34.     MsgBox "测试通过，按钮用的是自定义图标", vbInformation
    
35. End Sub
    
36. 
    
37. Public Sub test3(ByVal control As IRibbonControl)
    
38.     If Not xlApp.ActiveWorkbook Is Nothing Then
    
39.        xlApp.ActiveWorkbook.FollowHyperlink Address:="http://club.excelhome.net/thread-791154-1-1.html", NewWindow:=True
    
40.     Else
    
41.        MsgBox "没有活动工作簿", vbExclamation
    
42.     End If
    
43. End Sub

复制代码

VB工程文件 补充更新.rar (54.41 KB, 下载次数: 491)

2016-3-15 17:05 上传

点击文件名下载附件
VB工程文件

1207834011

学习，很受用

angryber2016

請問有2012的做法嗎？裝了vb6，但一直找不到excel的應用程序

nikonmonarch

记号学习了。

EH2003

终于更新了。

cz5460

mark，备用学习。

ashengz86

henrylam 发表于 2011-11-17 19:01
四、生成DLL文件
单击VB6.0菜单栏“文件”，再点击“生成Excel2010.dll ”，即可生成COM加载项文件。
新 ...

想问下楼主VB6.0和VS里的VB有什么不同

VBApplication

Excel2007下getimage回调函数不可用，还没找到解决方法.

左手转弯

大神，用你的方法已经测试成功。我把你的代码自己改了下，现在遇到了问题，test2我加载了一个窗体。
Public Sub test2(ByVal control As IRibbonControl)
    增加工作表.Show
End Sub
窗体我想实现，在TextBox输入内容，先判断表中存在是否重名，不重名则添加一个表，但是现在出现了问题，请大神帮助赐教，代码如下：
Dim ws As Worksheet
Dim jhao As String
jhao = 井号txt.Text
jhao = UCase(jhao)
On Error Resume Next
If jhao = "" Then
     MsgBox "请输入您要增加的工作表名！"
     Exit Sub
End If
For Each ws In Worksheets
    If ws.Name = jhao Then
     MsgBox "您输入的工作表已经存在，请重新输入！"
   Exit Sub
   End If
Next
Sheets.Add.Name = jhao
   Sheets(jhao).Move after:=Sheets(Sheets.Count)
Worksheets(1).Activate
End Sub

上面的代码执行到第二个if语句时，不管Textbox输入任何内容，都直接执行了MsgBox "您输入的工作表已经存在，请重新输入！"
包括后面增加工作表的代码也没有执行Sheets.Add.Name = jhao

VBApplication

发现自定义的图标一直显示不出来，查不到相关资料，想不通，基于office 2007 powerpoint