fieldset{padding:10px;}
Microsoft Project的RibbonXml VBA项目中不能使用带参数的过程
如果在Microsoft Project 使用以下代码：
Sub gallery_MSN_getItemCount(control As IRibbonControl, ByRef returnedVal) On Error Resume Next returnedVal = 12End SubPublic 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 SubSub 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 0End SubSub 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 ExplicitSub 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 0End SubPrivate 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
欢迎访问《许阳的红泥屋》大海，别为森林的渺小而沮丧，
