VB6.0封装Excel2007功能区菜单 ----Ribbon CustomUI 放在资源文件
1.下载安装VB6.0企业中文版（请自行百度搜索下载安装）
2.启动VB6.0，选择《外接程序》
3.【工程】---【引用】---Microsoft Excel 14.0 Objects Library和Microsoft Office 14.0 Objects Library（勾选）
4.设置Connect属性
5.清除原connect由系统产生的原码
输入如下内容：
Implements IDTExtensibility2
Implements IRibbonExtensibility
Public xlapp As Excel.Application
Private Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String
IRibbonExtensibility_GetCustomUI = LoadResString(101)
'用于从资源文件中载入自定义功能区的xml代码
End Function
Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
Set xlapp = Application '将xlapp赋值为Excel程序
End Sub
Private Sub IDTExtensibility2_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)
End Sub
Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant)
End Sub
Public Sub 完美(ByVal control As IRibbonControl)
Test1
End Sub
Public Sub 视频(ByVal control As IRibbonControl)
Test2
End Sub
Public Sub EH(ByVal control As IRibbonControl)
Test3
End Sub
Public Sub 解密(ByVal control As IRibbonControl)
Test4
End Sub
Public Sub 工作表加密(ByVal control As IRibbonControl)
Test5
End Sub
Sub Test1()
'完美
xlapp.ActiveWorkbook.FollowHyperlink _
Address:="http://www.excelbbs.com/forum.php", _
NewWindow:=True
End Sub
Sub Test2()
'视频
xlapp.ActiveWorkbook.FollowHyperlink _
Address:="http://www.56.com/h48/uv.index.php?user=caomingwumr", _
NewWindow:=True
End Sub
Sub Test3()
'EH
xlapp.ActiveWorkbook.FollowHyperlink _
Address:="http://club.excelhome.net/", _
NewWindow:=True
End Sub
Sub Test4()
'解密 备注这个代码是采集EH论坛一个前辈的的
With xlapp
.ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True, AllowUsingPivotTables:=True
.ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True, AllowUsingPivotTables:=True
.ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
False, AllowFiltering:=True, AllowUsingPivotTables:=True
.ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFiltering:=True, AllowUsingPivotTables:=True
.ActiveSheet.UnProtect
ANS = MsgBox("密码已破解", 48, "佛山小老鼠制作")
End With
End Sub
Sub Test5()
'工作表加密()
Dim I As Integer
For I = 1 To xlapp.Sheets.Count
xlapp.Sheets(I).Protect Password:="197698"
Next I
End Sub
6.【外接程序】---【外接程序管理器】--选取【VB 6 资源编辑器】---设置加载行为（具体见图）
7.【工具】--【资源编辑器】
8.点击【abc】图标（编辑字符串表格）--然后再【101】右边框中从（CustomUI.xml复制的代码）粘贴上去
9.【文件】---生成【xxx.dll】 如果有提示要保存，点确定即可。
'===========================================================
CustomUI 文件内容：
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="rxtabCustom"
label="佛山小老鼠工具"
insertBeforeMso="TabHome">
<group id="mygroupB" label="加解密">
<button id="a1"
imageMso="DatabasePermissions"
size="large"
label="工作表加密"
onAction="工作表加密"/>
<button id="a2"
imageMso="AdpDiagramKeys"
size="large"
label="工作表解密"
onAction="解密"/>
</group>
<group id="mygroupD" label="VBA开发">
<control idMso="VisualBasic" label="VBE编辑器" />
<control idMso="MacroRecord" label="录制新宏" />
<control idMso="ControlsGallery" label="窗体与控件" />
</group>
<group id="mygroupE" label="关于 佛山小老鼠">
<button id="E1"
imageMso="DataSourceCatalogServerScript"
size="large"
label="ExcelHome论坛"
onAction="EH"/>
<button id="E2"
imageMso="AccountMenu"
size="large"
label="完美论坛"
onAction="完美"/>
<button id="E3"
imageMso="FilePackageForCD"
size="large"
label="VBA入门视频"
onAction="视频"/>
</group>
</tab>
</tabs>
</ribbon>
</customUI>
