[SOLVED] Custom Ribbon XML, getting broken by VBA Form button clicks

[dmbalzer]

So I am developing a vba macro enabled Stencil for engineering purposes that creates a custom fluent ribbon Tab with buttons (only a Tab, group, and a few buttons for running specific subs) utilizing David J Parker's blog post https://davidjpp.wordpress.com/2011/03/14/how-to-run-vba-macros-from-a-ribbon-button-in-visio-2010/, adapting the code from the 2016 SDK sample.

I am using a form module that gets and sets user defined fields in the Document stencil for project info used throughout the document for titleblocks etc.

The form uses a class module that gets passed the Visio.ActiveDocument to get and set its own properties (just the Results from the specific document user cells).

Whenever I click my submit or cancel Buttons in the form it breaks the custom fluent ribbon i.e. the buttons stop working.

Any ideas as to what the form buttons are doing that are messing up the ribbon buttons?

The DocUserCellClass

Code Select Expand

Option Explicit

Private pProjName As String
Private pProjStreet As String
Private pProjCity As String
Private pProjState As String
Private pProjZip As String
Private pProjCountry As String

Public Sub GetProjInfo(doc As Visio.Document)
    GetProjName doc
    GetProjStreet doc
    GetProjCity doc
    GetProjState doc
    GetProjZip doc
    GetProjCountry doc
End Sub

Public Sub SetProjInfo(doc As Visio.Document)
    SetProjName doc
    SetProjStreet doc
    SetProjCity doc
    SetProjState doc
    SetProjZip doc
    SetProjCountry doc
End Sub
Private Sub SetProjName(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectName", 0) Then
        doc.DocumentSheet.CellsU("User.cpiProjectName").FormulaU = StrForFormula(pProjName)
    End If
End Sub
Private Sub SetProjStreet(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectStreet", 0) Then
       doc.DocumentSheet.CellsU("User.cpiProjectStreet").FormulaU = StrForFormula(pProjStreet)
    End If
End Sub
Private Sub SetProjCity(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectCity", 0) Then
        doc.DocumentSheet.CellsU("User.cpiProjectCity").FormulaU = StrForFormula(pProjCity)
    End If
End Sub
Private Sub SetProjState(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectStateProvince", 0) Then
        doc.DocumentSheet.CellsU("User.cpiProjectStateProvince").FormulaU = StrForFormula(pProjState)
    End If
End Sub
Private Sub SetProjZip(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectPostalCode", 0) Then
        doc.DocumentSheet.CellsU("User.cpiProjectPostalCode").FormulaU = StrForFormula(pProjZip)
    End If
End Sub
Private Sub SetProjCountry(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectCountry", 0) Then
        doc.DocumentSheet.CellsU("User.cpiProjectCountry").FormulaU = StrForFormula(pProjCountry)
    End If
End Sub
Private Sub GetProjName(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectName", 0) Then
        pProjName = doc.DocumentSheet.CellsU("User.cpiProjectName").ResultStrU("")
    End If
End Sub
Private Sub GetProjStreet(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectStreet", 0) Then
        pProjStreet = doc.DocumentSheet.CellsU("User.cpiProjectStreet").ResultStrU("")
    End If
End Sub
Private Sub GetProjCity(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectCity", 0) Then
        pProjCity = doc.DocumentSheet.CellsU("User.cpiProjectCity").ResultStrU("")
    End If
End Sub
Private Sub GetProjState(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectStateProvince", 0) Then
        pProjState = doc.DocumentSheet.CellsU("User.cpiProjectStateProvince").ResultStrU("")
    End If
End Sub
Private Sub GetProjZip(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectPostalCode", 0) Then
        pProjZip = doc.DocumentSheet.CellsU("User.cpiProjectPostalCode").ResultStrU("")
    End If
End Sub
Private Sub GetProjCountry(doc As Visio.Document)
    If doc.DocumentSheet.CellExistsU("User.cpiProjectCountry", 0) Then
        pProjCountry = doc.DocumentSheet.CellsU("User.cpiProjectCountry").ResultStrU("")
    End If
End Sub
' Getters-----------------------------
Public Property Get ProjName() As String
    ProjName = pProjName
End Property
Public Property Get ProjStreet() As String
    ProjStreet = pProjStreet
End Property
Public Property Get ProjCity() As String
    ProjCity = pProjCity
End Property
Public Property Get ProjState() As String
    ProjState = pProjState
End Property
Public Property Get ProjZip() As String
    ProjZip = pProjZip
End Property
Public Property Get ProjCountry() As String
    ProjCountry = pProjCountry
End Property
' Setters-----------------------------
Public Property Let ProjName(Value As String)
    pProjName = Value
End Property
Public Property Let ProjStreet(Value As String)
    pProjStreet = Value
End Property
Public Property Let ProjCity(Value As String)
    pProjCity = Value
End Property
Public Property Let ProjState(Value As String)
    pProjState = Value
End Property
Public Property Let ProjZip(Value As String)
    pProjZip = Value
End Property
Public Property Let ProjCountry(Value As String)
    pProjCountry = Value
End Property


The ribbon class:

Code Select Expand

Implements IRibbonExtensibility

Private pRibbonXML As String

Public Sub Class_Initialize()
    ' Tab name and a single group are named here
    ' May add additional groups later
    pRibbonXML = getHeader("CUSTOM TAB", "TOOLS")
   
    'more buttons can be added below, the buttonIDs need to match the OnAction case for a button click to call a sub
    ' Button Images are from "Office2010IconsGallery.docx"
    pRibbonXML = pRibbonXML & getButton(buttonID:="button1", buttonLbl:="Import SOO", buttonImage:="MindMapExportWord")
    pRibbonXML = pRibbonXML & getButton(buttonID:="button2", buttonLbl:="Button 2", buttonImage:="ColorNavy")
    pRibbonXML = pRibbonXML & getButton(buttonID:="button3", buttonLbl:="Button 3", buttonImage:="ColorLime")
    pRibbonXML = pRibbonXML & getButton(buttonID:="button4", buttonLbl:="Button 4", buttonImage:="ColorRed")
   
    pRibbonXML = pRibbonXML & getTerm()
End Sub

Public Function IRibbonExtensibility_GetCustomUI(ByVal RibbonID As String) As String

    IRibbonExtensibility_GetCustomUI = pRibbonXML
End Function

Public Sub OnAction(ByVal control As IRibbonControl)
    ' To execute a sub routine add the button id as a case, and then a call to the sub
    Select Case control.ID
        Case "button1"
            ThisDocument.ExecuteLine "importWordDocSOO"
        Case "button2"
            MsgBox "Button 2 was clicked"
        Case "button3"
            MsgBox "Button 3 was clicked"
        Case "button4"
            MsgBox "Button 4 was clicked"
    End Select
           
End Sub

Private Function getButton(buttonID As String, buttonLbl As String, buttonImage As String) As String
    getButton = "<button id=""" & buttonID & """ size=""large"" label=""" & buttonLbl & """ imageMso=""" & buttonImage & """ onAction=""OnAction""/>"
End Function

Private Function getHeader(tabLbl As String, grpLbl As String) As String
    getHeader = "<?xml version=""1.0"" encoding=""UTF-8""?>" & _
        "<!--Ribbon.xml" & _
        "<copyright>Copyright (c) Microsoft Corporation. All rights reserved." & _
        "</copyright>" & _
        "<summary>This XML file demonstrates how to define custom UI and its " & _
        "associated callbacks.</summary>" & _
        "-->" & _
        "<customUI onLoad=""OnRibbonLoad"" " & _
        "xmlns=""http://schemas.microsoft.com/office/2009/07/customui"">" & _
        "<!--This section defines custom Ribbon controls.-->" & _
        "<ribbon>" & _
        "<tabs>" & _
        "<tab id=""tab1"" label=""" & tabLbl & """>" & _
        "<group id=""group1"" label=""" & grpLbl & """>"
End Function

Private Function getTerm() As String
    getTerm = "</group>" & _
        "</tab>" & _
        "</tabs>" & _
        "</ribbon>" & _
        "</customUI>"
End Function



The ribbon loader and unloader:

Code Select Expand

Private msoCustomRibbon As clsRibbon

Public Sub CustomUIStart(ByVal vsoTargetDocument As Visio.Document)

' Abstract - This method loads custom UI from an XML file and associates it
' with the document object passed in.
'
' Parameters
' vsoTargetDocument     An open document in a running Visio application

    Dim vsoApplication As Visio.Application
   
    Set vsoApplication = Visio.Application
    Set msoCustomRibbon = New clsRibbon

    ' Passing in null rather than targetDocument would make the custom
    ' UI available for all documents.
    vsoApplication.RegisterRibbonX msoCustomRibbon, _
        vsoTargetDocument, _
        Visio.VisRibbonXModes.visRXModeDrawing, _
        "Custom Ribbon"
End Sub

Public Sub CustomUIStop(ByVal vsoTargetDocument As Visio.Document)

' Abstract - This method removes custom UI from a document.
'
' Parameters
' vsoTargetDocument     An open document in a running Visio application that
' has custom UI associated with it

    Dim vsoApplication As Visio.Application
    On Error Resume Next
    Set vsoApplication = Visio.Application
    vsoApplication.UnregisterRibbonX msoCustomRibbon, _
        vsoTargetDocument
End Sub



[dmbalzer]

So oddly enough I realized that I was running the form directly in the Visual Basic Editor (doing my form testing), and not creating a new form, and then showing it in a module sub.  Doing it this way did not break the custom ribbon, So I guess it is resolved!