SOLVED

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

Brass Contributor

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 to say it on this forum but happy to pay a small donation as I know the effort involved.

Many thanks 
James 

12 Replies
James_Price,
I remember there was an approach detailed in the no archived MSDN Project customization and programming forum but I can't locate it. However, you may find this thread useful:
https://social.msdn.microsoft.com/Forums/en-US/32d6a437-f9da-43fd-aa98-1c1740a1c798/add-button-in-ri...

John
Many thanks for this John but this looks like adding a ribbon in Project Server with Visual Studio.
James,
Now that I re-read your post, even the other MSDN posting I mentioned required Visual Studio and I see you're asking for a VBA approach. I know of no way to use VBA itself to do what you want.

What I have on my system are buttons on the Quick Access toolbar or a custom tab on the ribbon that activates oft-used macros.

John
Hi John
Actually there is. I did it many years ago but didn't keep the code... D'oh. It uses XML to do this.
Cheers
James
James,
Are you sure you did it with the ribbon GUI or was it perhaps with the pre-Project 2010 menu driven interface? The old menu driven interface was a lot more flexible. If it was with the ribbon GUI I'd be interested to hear (as might other users) on how XML played into the process.
John
Hi John - the old menus were a joy to change with VBA :-). I found this to give you a flavour of what needs to be done:

Private Sub AddEVMRibbon()
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=""macroTab"" label=""EVM"" insertAfterQ=""mso:TabFormat"">"
ribbonXml = ribbonXml + " <mso:group id=""testGroup"" label=""Test"" autoScale=""true"">"
ribbonXml = ribbonXml + " <mso:button id=""export_to_excel"" label=""Set EVM Calc Method"" "
ribbonXml = ribbonXml + "imageMso=""DiagramTargetInsertClassic"" onAction=""Set_EVM_Method""/>"
ribbonXml = ribbonXml + " <mso:button id=""get_evm_method"" label=""EVM to Excel"" "
ribbonXml = ribbonXml + "imageMso=""DiagramTargetInsertClassic"" onAction=""evm_to_excel""/>"
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



James,
Thanks, I'll have to try this when I get some time.

Update: Just for reference, the link provided for the schema is no longer active.
John

Hi John - that's really strange as we are using it fine.
James,
Are you sure it copied correctly when you posted? When I click on the link as it appears in your post, I get the message, "the resource you are looking for has been removed, had its name changed, or is temporarily unavailable." Same thing happens if I copy the link and paste into a new browser window.
John
Sorry John I can't explain it. We are using it in the VBA editor and the macro is working file.
James
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
best response confirmed by James_Price (Brass Contributor)
Solution
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)
1 best response

Accepted Solutions
best response confirmed by James_Price (Brass Contributor)
Solution
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)

View solution in original post