如何用VB6的COM外接程序定制word2007功能区[4-24更新代码]

三戒

备注：最新代码在7楼
用VB6的COM 外接程序可以方便的对office系列软件进行定制，下面是我在制作过程中的体会。
一、创建外接程序
启动VB，在新建工程对话框中选择“外接程序”，如图1所示

[ 本帖最后由 三戒 于 2009-4-24 10:10 编辑 ]

三戒

二、初始定制
1、在“项目资源管理器”窗口中，通过右键单击“Connect”打开设计器窗口，然后选择“查看对象”。从“应用程序”列表中选择“Microsoft Word”。
2、在“初始加载行为”列表中，选择“Startup”。
3、将外接程序显示名称更改为“Word 2007功能区测试 ”。
如图2所示

4、在项目资源管理器中，右键单击“MyAddin”，然后在“属性”窗口中将该外接程序的名称更改为“RibbonForWord2007”。
5、从该项目中删除“frmAddin”（这个在本例中暂时不需要）。
6、在工程－引用中将Microsoft Office Object 8.0更改为Microsoft Office Object 12。（备注：只有这样才能定制和添加对 IRibbonExtensibility 接口的引用）

三戒

三、输入代码
1、在“项目”窗口中，右键单击“Connect”项并选择“查看代码”。在设计器的代码窗口中删除所有代码，因为这些代码可用于 Visual Basic 外接程序而不适用于 Microsoft Office 外接程序。
2、输入如下的代码

Option Explicit
Dim oWD As Object
Implements IRibbonExtensibility2 '添加对 IRibbonExtensibility 接口的引用

'启动
Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
Set oWD = Application
MsgBox "我的com加载项已经成功加载！"
End Sub

'实现IRibbonExtensibility接口的唯一成员 GetCustomUI，此过程调用 GetRibbonXML 方法，正如其名称所示，
'该方法将自定义 XML 返回到 GetCustomUI 方法，后者然后将自定义 XML 添加到功能区用户界面以便在加载外接程序时实现它。
Public Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String
      IRibbonExtensibility_GetCustomUI = GetRibbonXML()
End Function

'添加 XML 自定义标记代码
Public Function GetRibbonXML() As String
   Dim sRibbonXML As String

    sRibbonXML = "<customUI xmlns=""http://schemas.microsoft.com/office/2006/01/customui"" >" & _
                "<ribbon>" & _
                "<tabs>" & _
                "<tab id=""CustomTab"" label=""sanjie"">" & _
                "<group id=""SampleGroup"" label=""Sample Group"">" & _
                "<button id=""Button"" label=""Insert Name"" size=""large"" imageMso=""HappyFace"" onAction=""InsertCompanyName"" />" & _
                "</group >" & _
                "</tab>" & _
                "</tabs>" & _
                "</ribbon>" & _
                "</customUI>"
   
   GetRibbonXML = sRibbonXML
   
   End Function

'控件回调的过程
Public Sub InsertCompanyName(ByVal control As IRibbonControl)
   ' Inserts the specified text at the beginning of a range.
   Dim MyText As String
   Dim MyRange As Object
   Set MyRange = oWD.ActiveDocument.Range
   MyText = "http://www.excelhome.net"
   ' Inserts text at the beginning
   ' of the active document.
   MyRange.InsertBefore (MyText)
End Sub

3、需要注意的是：了解XML语言和Office Ribbon定制技术的朋友，每一项元素的值必须要用英文4个双引号引起来。

三戒

四、发布该com加载项
单击菜单【文件】→【生成RibbonForWord2007.dll】即可完成加载项的发布。
五、测试
当你打开word2007的时候，如果成功加载首先会提示你“我的com加载项已经成功加载！”，然后会在功能区添加一个选项卡，如图3所示，单击该选项卡的按钮，就会自动输入信息。

三戒

第一次写这样的帖子，请多提建议，附件如下：

tangqingfu

做个记号，以便他日使用！现在用的是Word 2003，下次下个Word 2007使用学习一下！
谢谢三戒兄分享！

三戒

增加了根据word的版本生成工具栏的判别，如果是word 2007则增加功能区，2003及以前的版本增加菜单。

Option Explicit

Private oWD As Word.Application
Private WithEvents objButton1 As Office.CommandBarButton
Private WithEvents objButton2 As Office.CommandBarButton
Private WithEvents objButton3 As Office.CommandBarButton

Implements IRibbonExtensibility '添加对 IRibbonExtensibility 接口的引用

'========================================================================
  ''启动时执行的任务
'========================================================================

Private Sub AddinInstance_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
Set oWD = Application
Select Case oWD.Version
      Case "12.0"
        MsgBox "你正使用的版本是Office 12"
      Case "11.0"
        MsgBox "你正使用的版本是Office 11"
        Call CreateMenu
      Case Else
        MsgBox oWD.Version
        Call CreateMenu
End Select
        
End Sub


'========================================================================
  '移除时执行的任务
'========================================================================
Private Sub AddinInstance_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
  Call DeleteMenu
  Set objButton1 = Nothing
  Set objButton2 = Nothing
  Set objButton3 = Nothing
  Set oWD = Nothing
End Sub


'========================================================================
  ''实现IRibbonExtensibility接口的唯一成员 GetCustomUI，此过程调用 GetRibbonXML 方法，正如其名称所示，
'该方法将自定义 XML 返回到 GetCustomUI 方法，后者然后将自定义 XML 添加到功能区用户界面以便在加载外接程序时实现它。
'========================================================================
Public Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String
      IRibbonExtensibility_GetCustomUI = GetRibbonXML()
End Function


'========================================================================
  '添加 XML 自定义标记代码
'========================================================================

Public Function GetRibbonXML() As String
   Dim sRibbonXML As String

    sRibbonXML = "<customUI xmlns=""http://schemas.microsoft.com/office/2006/01/customui"" >" & _
                "<ribbon>" & _
                "<tabs>" & _
                "<tab id=""CustomTab"" label=""sanjie"">" & _
                "<group id=""SampleGroup"" label=""Sample Group"">" & _
                "<button id=""Button"" label=""Insert Name"" size=""large"" imageMso=""HappyFace"" onAction=""InsertCompanyName"" />" & _
                "</group >" & _
                "</tab>" & _
                "</tabs>" & _
                "</ribbon>" & _
                "</customUI>"
   
   GetRibbonXML = sRibbonXML
   
End Function


'========================================================================
  ''控件回调的过程
'========================================================================

Public Sub InsertCompanyName(ByVal control As IRibbonControl)
   ' Inserts the specified text at the beginning of a range.
   Dim MyText As String
   Dim MyRange As Object
   Set MyRange = oWD.ActiveDocument.Range
   MyText = "http://www.excelhome.net"
   ' Inserts text at the beginning
   ' of the active document.
   MyRange.InsertBefore (MyText)
End Sub


'========================================================================
  '创建2003菜单
'========================================================================

Private Sub CreateMenu()

    Dim NewMenu As Office.CommandBarPopup
   
    Call DeleteMenu
        
    Set NewMenu = oWD.CommandBars("Menu Bar").Controls.Add(Type:=msoControlPopup, Temporary:=True)

    With NewMenu
        .Caption = "sanjie"
       Set objButton1 = .Controls.Add(Type:=msoControlButton)
           With objButton1
              .Caption = "输入信息"
              .FaceId = 23
              .Tag = "Button1"
           End With
   
       Set objButton2 = .Controls.Add(Type:=msoControlButton)
          With objButton2
              .Caption = "显示当前Word版本"
              .FaceId = 116
              .Tag = "Button2"
          End With
   
      Set objButton3 = .Controls.Add(Type:=msoControlButton)
         With objButton3
              .Caption = "关于..."
             .BeginGroup = True
             .FaceId = 984
             .Tag = "Button3"
         End With
    End With
End Sub

'========================================================================
  '删除菜单2003
'========================================================================

Private Sub DeleteMenu()
    On Error Resume Next
    'CommandBars(1).Reset
    oWD.CommandBars("Menu Bar").Controls("sanjie").Delete
End Sub

'========================================================================
  '按钮1的动作
'========================================================================

Private Sub objButton1_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   Dim MyText As String
   Dim MyRange As Object
   Set MyRange = oWD.ActiveDocument.Range
   MyText = "http://www.excelhome.net"
   MyRange.InsertBefore (MyText)
End Sub

'========================================================================
  '按钮2的动作
'========================================================================
Private Sub objButton2_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   MsgBox oWD.Version
End Sub

'========================================================================
  '按钮3的动作
'========================================================================

Private Sub objButton3_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
   MsgBox "三戒制作！", vbInformation, Title:="ok"
End Sub

[ 本帖最后由 三戒 于 2009-4-24 10:05 编辑 ]

三戒

这是编译好的dll文件，有兴趣的朋友请测试

[ 本帖最后由 三戒 于 2009-4-24 09:54 编辑 ]

wjhere

谢谢分享，请教三戒兄，IRibbonExtensibility接口的问题，我第一次接触，不知有什么作用，是为了实现在word2007中功能区的定制，还是别的功能？能否详细说明？
在2003中测试 ，不知三戒兄注意到没有，您的加载项存在我们讨论过的一个问题：按钮只对第一个文档有效。卸载后菜单没有彻底卸载。

[ 本帖最后由 wjhere 于 2009-4-23 19:08 编辑 ]

三戒

原帖由 wjhere 于 2009-4-23 18:45 发表
谢谢分享，请教三戒兄，IRibbonExtensibility接口的问题，我第一次接触，不知有什么作用，是为了实现在word2007中功能区的定制，还是别的功能？能否详细说明？
在2003中测试 ，不知三戒兄注意到没有，您的加载项存在 ...

1、创建加载项项目后，需要实现 IRibbonExtensibility 接口（该接口包括在 Microsoft.Office.Core 命名空间中）。此接口包含一个称为 GetCustomUI 的方法。使用此方法可将 XML 功能区自定义代码返回到 Office 应用程序。然后您可以添加编程过程，实现自定义功能区的功能。
2、刚才又测试了一番，没有您说的按钮只对第一个文档有效。卸载后菜单没有彻底卸载。