Microsoft Project的RibbonXml VBA项目中不能使用带参数的过程

最新推荐文章于 2024-05-10 11:33:39 发布

原创最新推荐文章于 2024-05-10 11:33:39 发布 · 1.3k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#microsoft #vba #integer #tabs #string #callback

Office Development 同时被 2 个专栏收录

134 篇文章

订阅专栏

Microsoft Project 2010

1 篇文章

订阅专栏

本文介绍如何在Microsoft Project中通过VBA自定义Ribbon菜单，并创建一个包含多个选项的下拉菜单项，实现点击菜单项后弹出提示框的功能。

如果在Microsoft Project 使用以下代码：

Sub gallery_MSN_getItemCount(control As IRibbonControl, ByRef returnedVal)
     
     On Error Resume Next
     returnedVal = 12

End Sub

Public Sub gallery_MSN_getItemLabels(control As IRibbonControl, index As Integer, ByRef returnedVal)
 'This callback runs for every item (label).
 'This example uses the values in the array for Label names.
    
     Dim Labelname As Variant
     On Error Resume Next
     Labelname = _
     Array("Sheila Webster", _
           "Brian Main", _
           "Susan Zhang", _
           "Anne Walzer", _
           "Andrea Vogel", _
           "Ronda Viescas", _
           "Norman Harker", _
           "Michelle Wells", _
           "Wilma Yang", _
           "Angel Wang", _
           "Raymond Denny", _
           "June Winograd")

    On Error Resume Next
     returnedVal = Labelname(index)
     On Error GoTo 0


 End Sub

Sub gallery_MSN_Click(control As IRibbonControl, id As String, index As Integer)

'Call the macro that belongs to the label when you click one of the labels.
 'Example: When you click the first label it runs the macro named "macro_1".
     On Error Resume Next
     MsgBox ("It works !")
     On Error GoTo 0

End Sub

Sub test()
    Dim strXML As String
    
    strXML = "<mso:customUI xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">"
     strXML = strXML & "<mso:ribbon>"
     strXML = strXML & "<mso:qat/>"
     strXML = strXML & "     <mso:tabs>"
     strXML = strXML & "     <mso:tab id=""PlannersTab"" label=""Planners"" insertBeforeQ=""mso:TabResource"">"
     
     strXML = strXML & "         <mso:group id=""GroupMove"" label=""Move"" autoScale=""true"">"



    strXML = strXML & "         <mso:gallery  id=""MSN"" "
     strXML = strXML & "                label=""Go to MSN"" "
     strXML = strXML & "                imageMso=""MenuTaskWellArrange"" "
     strXML = strXML & "                size=""large"""

     strXML = strXML & "                columns=""3"" "
     strXML = strXML & "                rows=""10"" "

    strXML = strXML & "                getItemCount=""gallery_MSN_getItemCount"" "
     strXML = strXML & "                getItemLabel=""gallery_MSN_getItemLabels"" "
     
     strXML = strXML & "                showItemLabel=""true"" "
      
     strXML = strXML & "                onAction=""gallery_MSN_Click"" >"

    strXML = strXML & "          </mso:gallery>"


    strXML = strXML & "         </mso:group>"
     strXML = strXML & "     </mso:tab>"
     strXML = strXML & "     </mso:tabs>"
     strXML = strXML & "</mso:ribbon>"
     strXML = strXML & "</mso:customUI>"
     
 ActiveProject.SetCustomUI (strXML)

End Sub

会报"Automation error"的错误。其原因在于不能使用带项目的参数。如果改成下面这个样子就可以了：

Option Explicit

Sub gallery_MSN_Click()

 'Call the macro that belongs to the label when you click one of the labels.
 'Example: When you click the first label it runs the macro named "macro_1".
     On Error Resume Next
     MsgBox ("It works")
     On Error GoTo 0

End Sub

Private Sub AddHighlightRibbon()
    Dim ribbonXml As String
    Dim MyArray As Variant
    Dim item As Variant
    Dim cnt As Integer
    
    cnt = 0
    MyArray = Array("Sheila Webster", "Brian Main", "Susan Zhang", "Anne Walzer", "Andrea Vogel", "Ronda Viescas", _
           "Norman Harker", _
           "Michelle Wells", _
           "Wilma Yang", _
           "Angel Wang", _
           "Raymond Denny", _
           "June Winograd")
           
    ribbonXml = "<mso:customUI xmlns:mso=""http://schemas.microsoft.com/office/2009/07/customui"">"
    ribbonXml = ribbonXml + "  <mso:ribbon>"
    ribbonXml = ribbonXml + "    <mso:qat/>"
    ribbonXml = ribbonXml + "    <mso:tabs>"
    ribbonXml = ribbonXml + "      <mso:tab id=""highlightTab"" label=""Highlight"" insertBeforeQ=""mso:TabFormat"">"
    ribbonXml = ribbonXml + "        <mso:group id=""testGroup"" label=""Test"" autoScale=""true"">"
    ribbonXml = ribbonXml + "         <mso:gallery  id=""MSN"" "
    ribbonXml = ribbonXml + "                label=""Go to MSN"" "
    ribbonXml = ribbonXml + "                imageMso=""MenuTaskWellArrange"" "
    ribbonXml = ribbonXml + "                size=""large"""
    ribbonXml = ribbonXml + "                columns=""3"" "
    ribbonXml = ribbonXml + "                rows=""10"" "
    ribbonXml = ribbonXml + "                showItemLabel=""true"" "
    ribbonXml = ribbonXml + "                onAction=""gallery_MSN_Click"" >"
    For Each item In MyArray
        ribbonXml = ribbonXml + "               <mso:item id=""item" + CStr(cnt) + """ label=""" + item + """></mso:item>"
        cnt = cnt + 1
    Next
    ribbonXml = ribbonXml + "          </mso:gallery>"
    ribbonXml = ribbonXml + "        </mso:group>"
    ribbonXml = ribbonXml + "      </mso:tab>"
    ribbonXml = ribbonXml + "    </mso:tabs>"
    ribbonXml = ribbonXml + "  </mso:ribbon>"
    ribbonXml = ribbonXml + "</mso:customUI>"
    ActiveProject.SetCustomUI (ribbonXml)
End Sub

欢迎访问《许阳的红泥屋》