Forum Discussion

James_Price's avatar
James_Price
Brass Contributor
Feb 18, 2022

MS Project VBA to add a button to run a macro...

Hi team  A big ask:  Does anyone have some VBA code that adds a button to a tab and assigns to a macro when a project file is open, and then hides when the macro is closed.  Not sure if I'm allowed...
  • James_Price's avatar
    James_Price
    Feb 24, 2022
    Hi John - I'm using MS Project Online Desktop client. Below is the code that is working for me. Like you I'm not an xml person but this works for me.

    ' Name Proc for Error Handler Message
    strProcedure = "sAddCustomRibbon"

    Dim ribbonXml As String

    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=""tabCustom"" label=""Split / Collapse Tasks"" insertAfterQ=""mso:TabFormat"">"
    ribbonXml = ribbonXml + " <mso:group id=""grpSplitCollapse"" label=""Split / Collapse"" autoScale=""true"">"
    ribbonXml = ribbonXml + " <mso:button id=""btnSplitTasks"" label=""Split Tasks"" size=""large"" imageMso=""CellsDelete"" onAction=""sSplitTasks""/>"
    ribbonXml = ribbonXml + " <mso:button id=""btnCollapseTasks"" label=""Collapse Tasks"" size=""large"" imageMso=""CellsInsertDialog"" onAction=""sCollapseTasks""/>"
    ribbonXml = ribbonXml + " </mso:group>"
    ribbonXml = ribbonXml + " </mso:tab>"
    ribbonXml = ribbonXml + " </mso:tabs>"
    ribbonXml = ribbonXml + " </mso:ribbon>"
    ribbonXml = ribbonXml + "</mso:customUI>"

    ActiveProject.SetCustomUI (ribbonXml)
John-project's avatar
John-project
Silver Contributor
James,
I tried a different approach. I pasted the code you posted into a Project file (Project Pro 2019). I got a compile error but once I removed the quotes ("") from the http... string, the macro ran but didn't appear to do anything. I got some flashing of the ribbon when the last line of code executed but that was it. I must be missing something. For reference, I've never worked with XML code so I'm sure that has something to do with it.
John
James_Price's avatar
James_Price
Brass Contributor
Feb 24, 2022
Hi John - I'm using MS Project Online Desktop client. Below is the code that is working for me. Like you I'm not an xml person but this works for me.

' Name Proc for Error Handler Message
strProcedure = "sAddCustomRibbon"

Dim ribbonXml As String

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=""tabCustom"" label=""Split / Collapse Tasks"" insertAfterQ=""mso:TabFormat"">"
ribbonXml = ribbonXml + " <mso:group id=""grpSplitCollapse"" label=""Split / Collapse"" autoScale=""true"">"
ribbonXml = ribbonXml + " <mso:button id=""btnSplitTasks"" label=""Split Tasks"" size=""large"" imageMso=""CellsDelete"" onAction=""sSplitTasks""/>"
ribbonXml = ribbonXml + " <mso:button id=""btnCollapseTasks"" label=""Collapse Tasks"" size=""large"" imageMso=""CellsInsertDialog"" onAction=""sCollapseTasks""/>"
ribbonXml = ribbonXml + " </mso:group>"
ribbonXml = ribbonXml + " </mso:tab>"
ribbonXml = ribbonXml + " </mso:tabs>"
ribbonXml = ribbonXml + " </mso:ribbon>"
ribbonXml = ribbonXml + "</mso:customUI>"

ActiveProject.SetCustomUI (ribbonXml)

Resources