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>