Option Explicit

Enum ParagraphRole
    Paragraph = 1
    Heading = 2
    ListContinue = 3
    Caption = 4
    BlockQuote = 5
    HeaderCell = 6
    HeaderCellComplex = 7
    Artifact = 8
End Enum

Sub Test()

    ' Get the built-in style Quote
    Dim quote As Style
    Set quote = ActiveDocument.Styles(WdBuiltinStyle.wdStyleQuote)

    ' Map the style to the role "BlockQuote"
    MapStyleToRole quote, ParagraphRole.BlockQuote
    
    ' Reset the style role (uncomment the next line to execute)
    ' ResetStyleRole quote

End Sub

Function Ns()

    ' Return the axesWord XML namespace
    Ns = "http://ns.axespdf.com/word/configuration"

End Function

Sub MapStyleToRole(wordStyle As Style, role As ParagraphRole, Optional levelOrScope As Integer, Optional down As Boolean, Optional right As Boolean, Optional up As Boolean, Optional left As Boolean, Optional mergedHeader As Integer, Optional mergedChild As Integer)

    If Not wordStyle.Type = wdStyleTypeParagraph Then
        Err.Raise vbObjectError + 1000, "axes4XMLSamples", "Only paragraph styles can be mapped to roles."
        Exit Sub
    End If

    ' Ensure that our custom XML part exists
    Dim axesXml As Office.customXmlPart
    Set axesXml = GetOrCreateAxes4CustomXmlPart()

    ' Get the correct XML name for the Word style
    Dim customXmlStyleName As String
    customXmlStyleName = GetCustomXmlStyleName(wordStyle)
    
    ' Get the prefix that we need for the node search
    Dim prefix As String
    prefix = axesXml.NamespaceManager.LookupPrefix(Ns()) & ":"

    ' Get the root node "<c:group id="Styles">"
    Dim stylesRootNode As CustomXMLNode
    Set stylesRootNode = axesXml.DocumentElement.SelectSingleNode(prefix & "group[@id='Styles']")

    ' Get the child node for the specified style
    Dim styleNode As CustomXMLNode
    Set styleNode = stylesRootNode.SelectSingleNode(prefix & "group[@id='" & customXmlStyleName & "']")
    
    ' Compose the XML depending on the role
    Dim xml As String
    Select Case role
        Case ParagraphRole.Paragraph
            xml = GetParagraphXml(customXmlStyleName)
        Case ParagraphRole.Heading
            xml = GetHeadingXml(customXmlStyleName, levelOrScope)
        Case ParagraphRole.ListContinue
            xml = GetListContinueXml(customXmlStyleName, levelOrScope)
        Case ParagraphRole.Caption
            xml = GetCaptionXml(customXmlStyleName)
        Case ParagraphRole.BlockQuote
            xml = GetBlockQuoteXml(customXmlStyleName)
        Case ParagraphRole.HeaderCell
            xml = GetHeaderCellXml(customXmlStyleName, levelOrScope)
        Case ParagraphRole.HeaderCellComplex
            xml = GetHeaderCellComplexXml(customXmlStyleName, levelOrScope, down, right, up, left, mergedHeader, mergedChild)
        Case ParagraphRole.Artifact
            xml = GetArtifactXml(customXmlStyleName)
    End Select
    
    ' Append or replace the node
    If styleNode Is Nothing Then
        stylesRootNode.AppendChildSubtree xml
    Else
        stylesRootNode.ReplaceChildSubtree xml, styleNode
    End If

End Sub

Sub ResetStyleRole(wordStyle As Style)

    If Not wordStyle.Type = wdStyleTypeParagraph Then
        Err.Raise vbObjectError + 1000, "axes4XMLSamples", "Only paragraph styles can be mapped to roles."
        Exit Sub
    End If

    ' Ensure that our custom XML part exists
    Dim axesXml As Office.customXmlPart
    Set axesXml = GetOrCreateAxes4CustomXmlPart()

    ' Get the correct XML name for the Word style
    Dim customXmlStyleName As String
    customXmlStyleName = GetCustomXmlStyleName(wordStyle)
    
    ' Get the prefix that we need for the node search
    Dim prefix As String
    prefix = axesXml.NamespaceManager.LookupPrefix(Ns()) & ":"

    ' Get the root node "<c:group id="Styles">"
    Dim stylesRootNode As CustomXMLNode
    Set stylesRootNode = axesXml.DocumentElement.SelectSingleNode(prefix & "group[@id='Styles']")

    ' Get the child node for the specified style
    Dim styleNode As CustomXMLNode
    Set styleNode = stylesRootNode.SelectSingleNode(prefix & "group[@id='" & customXmlStyleName & "']")
    
    ' Delete the node if it exists
    If Not styleNode Is Nothing Then
        styleNode.Delete
    End If

End Sub

Function GetParagraphXml(customXmlStyleName As String) As String

    ' Get the XML for the role "ParagraphParagraph"
    GetParagraphXml = GetSimpleXml(customXmlStyleName, "ParagraphParagraph")

End Function

Function GetCaptionXml(customXmlStyleName As String) As String

    ' Get the XML for the role "ParagraphCaption"
    GetCaptionXml = GetSimpleXml(customXmlStyleName, "ParagraphCaption")

End Function

Function GetBlockQuoteXml(customXmlStyleName As String) As String

    ' Get the XML for the role "ParagraphBlockQuote"
    GetBlockQuoteXml = GetSimpleXml(customXmlStyleName, "ParagraphBlockQuote")

End Function

Function GetArtifactXml(customXmlStyleName As String) As String

    ' Get the XML for the role "ParagraphArtifact"
    GetArtifactXml = GetSimpleXml(customXmlStyleName, "ParagraphArtifact")

End Function

Function GetSimpleXml(customXmlStyleName As String, role As String) As String

    GetSimpleXml = _
        "<c:group xmlns:c='" & Ns() & "' id='" & customXmlStyleName & "'>" & _
            "<c:property xmlns:c='" & Ns() & "' id='RoleID' type='string'>" & role & "</c:property>" & _
        "</c:group>"

End Function

Function GetHeadingXml(customXmlStyleName As String, level As Integer) As String

    ' Get the XML for the role "ParagraphHeading"
    GetHeadingXml = GetIntPropertyXml(customXmlStyleName, "ParagraphHeading", "Level", level)


End Function

Function GetListContinueXml(customXmlStyleName As String, level As Integer) As String

    ' Get the XML for the role "ParagraphListContinue"
    GetListContinueXml = GetIntPropertyXml(customXmlStyleName, "ParagraphListContinue", "Level", level)

End Function

Function GetHeaderCellXml(customXmlStyleName As String, scope As Integer) As String

    ' Get the XML for the role "ParagraphHeaderCell" (simple tables)
    GetHeaderCellXml = GetIntPropertyXml(customXmlStyleName, "ParagraphHeaderCell", "Scope", scope)

End Function

Function GetIntPropertyXml(customXmlStyleName As String, role As String, propertyName As String, propertyValue As Integer) As String

    GetIntPropertyXml = _
        "<c:group xmlns:c='" & Ns() & "' id='" & customXmlStyleName & "'>" & _
            "<c:property xmlns:c='" & Ns() & "' id='RoleID' type='string'>" & role & "</c:property>" & _
            "<c:property xmlns:c='" & Ns() & "' id='" & propertyName & "' type='integer'>" & propertyValue & "</c:property>" & _
        "</c:group>"

End Function

Function GetHeaderCellComplexXml(customXmlStyleName As String, level As Integer, down As Boolean, right As Boolean, up As Boolean, left As Boolean, mergedHeader As Integer, mergedChild As Integer) As String

    ' Get the XML for the role "ParagraphHeaderCellComplex" (complex tables)
    ' Note: The property "MergedHaeder" is written correctly here, it's a typo in the source code of axesWord

    GetHeaderCellComplexXml = _
        "<c:group xmlns:c='" & Ns() & "' id='" & customXmlStyleName & "'>" & _
            "<c:property xmlns:c='" & Ns() & "' id='RoleID' type='string'>ParagraphHeaderCellComplex</c:property>" & _
            "<c:property xmlns:c='" & Ns() & "' id='Level' type='integer'>" & level & "</c:property>" & _
            "<c:property xmlns:c='" & Ns() & "' id='Down' type='boolean'>" & GetBooleanString(down) & "</c:property>" & _
            "<c:property xmlns:c='" & Ns() & "' id='Right' type='boolean'>" & GetBooleanString(right) & "</c:property>" & _
            "<c:property xmlns:c='" & Ns() & "' id='Up' type='boolean'>" & GetBooleanString(up) & "</c:property>" & _
            "<c:property xmlns:c='" & Ns() & "' id='Left' type='boolean'>" & GetBooleanString(left) & "</c:property>" & _
            "<c:property xmlns:c='" & Ns() & "' id='MergedHaeder' type='integer'>" & mergedHeader & "</c:property>" & _
            "<c:property xmlns:c='" & Ns() & "' id='MergedChild' type='integer'>" & mergedChild & "</c:property>" & _
        "</c:group>"

End Function

Function GetOrCreateAxes4CustomXmlPart() As customXmlPart

    ' Check if the CustomXMLPart for axes4 exists in the document. If not, create it

    Dim customXmlPart As customXmlPart
    Dim customXmlParts As customXmlParts
    Set customXmlParts = ActiveDocument.customXmlParts.SelectByNamespace(Ns())
    
    If customXmlParts.Count = 0 Then
        
        Set customXmlPart = ActiveDocument.customXmlParts.Add
        customXmlPart.NamespaceManager.AddNamespace "c", Ns
        
        Dim xmlString As String
        
        ' XML content for the CustomXmlPart
        xmlString = "<c:configuration xmlns:c='" & Ns & "'>" & _
                        "<c:group id='Styles'></c:group>" & _
                        "<c:group id='Content'></c:group>" & _
                        "<c:group id='InitialView'></c:group>" & _
                    "</c:configuration>"
        customXmlPart.LoadXML xmlString
        
    Else
        Set customXmlPart = customXmlParts(1)
    End If
    
    Set GetOrCreateAxes4CustomXmlPart = customXmlPart

End Function

Function GetCustomXmlStyleName(wordStyle As Style) As String

    If Not wordStyle.BuiltIn Then
        GetCustomXmlStyleName = wordStyle.NameLocal
        Exit Function
    End If

    Dim styleEnum As Integer
    
    ' Determine the WdBuiltinStyle value of the style.
    ' There is no property for this on the Style object, thus we have to loop
    ' through all document styles and do a comparison
    For styleEnum = -1 To -270 Step -1
        If wordStyle.NameLocal = ActiveDocument.Styles(styleEnum).NameLocal Then
            Exit For
        End If
    Next
    
    ' Find the XML style name
    Dim styleName As String
    Select Case styleEnum
        Case wdStyleNormal
            styleName = "__Normal"
        Case wdStyleHeading1
            styleName = "__Heading1"
        Case wdStyleHeading2
            styleName = "__Heading2"
        Case wdStyleHeading3
            styleName = "__Heading3"
        Case wdStyleHeading4
            styleName = "__Heading4"
        Case wdStyleHeading5
            styleName = "__Heading5"
        Case wdStyleHeading6
            styleName = "__Heading6"
        Case wdStyleHeading7
            styleName = "__Heading7"
        Case wdStyleHeading8
            styleName = "__Heading8"
        Case wdStyleHeading9
            styleName = "__Heading9"
        Case wdStyleIndex1
            styleName = "__Index1"
        Case wdStyleIndex2
            styleName = "__Index2"
        Case wdStyleIndex3
            styleName = "__Index3"
        Case wdStyleIndex4
            styleName = "__Index4"
        Case wdStyleIndex5
            styleName = "__Index5"
        Case wdStyleIndex6
            styleName = "__Index6"
        Case wdStyleIndex7
            styleName = "__Index7"
        Case wdStyleIndex8
            styleName = "__Index8"
        Case wdStyleIndex9
            styleName = "__Index9"
        Case wdStyleTOC1
            styleName = "__TOC1"
        Case wdStyleTOC2
            styleName = "__TOC2"
        Case wdStyleTOC3
            styleName = "__TOC3"
        Case wdStyleTOC4
            styleName = "__TOC4"
        Case wdStyleTOC5
            styleName = "__TOC5"
        Case wdStyleTOC6
            styleName = "__TOC6"
        Case wdStyleTOC7
            styleName = "__TOC7"
        Case wdStyleTOC8
            styleName = "__TOC8"
        Case wdStyleTOC9
            styleName = "__TOC9"
        Case wdStyleNormalIndent
            styleName = "__NormalIndent"
        Case wdStyleFootnoteText
            styleName = "__FootnoteText"
        Case wdStyleCommentText
            styleName = "__CommentText"
        Case wdStyleHeader
            styleName = "__Header"
        Case wdStyleFooter
            styleName = "__Footer"
        Case wdStyleIndexHeading
            styleName = "__IndexHeading"
        Case wdStyleCaption
            styleName = "__Caption"
        Case wdStyleTableOfFigures
            styleName = "__TableOfFigures"
        Case wdStyleEnvelopeAddress
            styleName = "__EnvelopeAddress"
        Case wdStyleEnvelopeReturn
            styleName = "__EnvelopeReturn"
        Case wdStyleFootnoteReference
            styleName = "__FootnoteReference"
        Case wdStyleCommentReference
            styleName = "__CommentReference"
        Case wdStyleLineNumber
            styleName = "__LineNumber"
        Case wdStylePageNumber
            styleName = "__PageNumber"
        Case wdStyleEndnoteReference
            styleName = "__EndnoteReference"
        Case wdStyleEndnoteText
            styleName = "__EndnoteText"
        Case wdStyleTableOfAuthorities
            styleName = "__TableOfAuthorities"
        Case wdStyleMacroText
            styleName = "__MacroText"
        Case wdStyleTOAHeading
            styleName = "__TOAHeading"
        Case wdStyleList
            styleName = "__List"
        Case wdStyleListBullet
            styleName = "__ListBullet"
        Case wdStyleListNumber
            styleName = "__ListNumber"
        Case wdStyleList2
            styleName = "__List2"
        Case wdStyleList3
            styleName = "__List3"
        Case wdStyleList4
            styleName = "__List4"
        Case wdStyleList5
            styleName = "__List5"
        Case wdStyleListBullet2
            styleName = "__ListBullet2"
        Case wdStyleListBullet3
            styleName = "__ListBullet3"
        Case wdStyleListBullet4
            styleName = "__ListBullet4"
        Case wdStyleListBullet5
            styleName = "__ListBullet5"
        Case wdStyleListNumber2
            styleName = "__ListNumber2"
        Case wdStyleListNumber3
            styleName = "__ListNumber3"
        Case wdStyleListNumber4
            styleName = "__ListNumber4"
        Case wdStyleListNumber5
            styleName = "__ListNumber5"
        Case wdStyleTitle
            styleName = "__Title"
        Case wdStyleClosing
            styleName = "__Closing"
        Case wdStyleSignature
            styleName = "__Signature"
        Case wdStyleDefaultParagraphFont
            styleName = "__DefaultParagraphFont"
        Case wdStyleBodyText
            styleName = "__BodyText"
        Case wdStyleBodyTextIndent
            styleName = "__BodyTextIndent"
        Case wdStyleListContinue
            styleName = "__ListContinue"
        Case wdStyleListContinue2
            styleName = "__ListContinue2"
        Case wdStyleListContinue3
            styleName = "__ListContinue3"
        Case wdStyleListContinue4
            styleName = "__ListContinue4"
        Case wdStyleListContinue5
            styleName = "__ListContinue5"
        Case wdStyleMessageHeader
            styleName = "__MessageHeader"
        Case wdStyleSubtitle
            styleName = "__Subtitle"
        Case wdStyleSalutation
            styleName = "__Salutation"
        Case wdStyleDate
            styleName = "__Date"
        Case wdStyleBodyTextFirstIndent
            styleName = "__BodyTextFirstIndent"
        Case wdStyleBodyTextFirstIndent2
            styleName = "__BodyTextFirstIndent2"
        Case wdStyleNoteHeading
            styleName = "__NoteHeading"
        Case wdStyleBodyText2
            styleName = "__BodyText2"
        Case wdStyleBodyText3
            styleName = "__BodyText3"
        Case wdStyleBodyTextIndent2
            styleName = "__BodyTextIndent2"
        Case wdStyleBodyTextIndent3
            styleName = "__BodyTextIndent3"
        Case wdStyleBlockQuotation
            styleName = "__BlockQuotation"
        Case wdStyleHyperlink
            styleName = "__Hyperlink"
        Case wdStyleHyperlinkFollowed
            styleName = "__HyperlinkFollowed"
        Case wdStyleStrong
            styleName = "__Strong"
        Case wdStyleEmphasis
            styleName = "__Emphasis"
        Case wdStyleNavPane
            styleName = "__NavPane"
        Case wdStylePlainText
            styleName = "__PlainText"
        Case wdStyleHtmlNormal
            styleName = "__HtmlNormal"
        Case wdStyleHtmlAcronym
            styleName = "__HtmlAcronym"
        Case wdStyleHtmlAddress
            styleName = "__HtmlAddress"
        Case wdStyleHtmlCite
            styleName = "__HtmlCite"
        Case wdStyleHtmlCode
            styleName = "__HtmlCode"
        Case wdStyleHtmlDfn
            styleName = "__HtmlDfn"
        Case wdStyleHtmlKbd
            styleName = "__HtmlKbd"
        Case wdStyleHtmlPre
            styleName = "__HtmlPre"
        Case wdStyleHtmlSamp
            styleName = "__HtmlSamp"
        Case wdStyleHtmlTt
            styleName = "__HtmlTt"
        Case wdStyleHtmlVar
            styleName = "__HtmlVar"
        Case wdStyleNormalTable
            styleName = "__NormalTable"
        Case wdStyleNormalObject
            styleName = "__NormalObject"
        Case wdStyleTableLightShading
            styleName = "__TableLightShading"
        Case wdStyleTableLightList
            styleName = "__TableLightList"
        Case wdStyleTableLightGrid
            styleName = "__TableLightGrid"
        Case wdStyleTableMediumShading1
            styleName = "__TableMediumShading1"
        Case wdStyleTableMediumShading2
            styleName = "__TableMediumShading2"
        Case wdStyleTableMediumList1
            styleName = "__TableMediumList1"
        Case wdStyleTableMediumList2
            styleName = "__TableMediumList2"
        Case wdStyleTableMediumGrid1
            styleName = "__TableMediumGrid1"
        Case wdStyleTableMediumGrid2
            styleName = "__TableMediumGrid2"
        Case wdStyleTableMediumGrid3
            styleName = "__TableMediumGrid3"
        Case wdStyleTableDarkList
            styleName = "__TableDarkList"
        Case wdStyleTableColorfulShading
            styleName = "__TableColorfulShading"
        Case wdStyleTableColorfulList
            styleName = "__TableColorfulList"
        Case wdStyleTableColorfulGrid
            styleName = "__TableColorfulGrid"
        Case wdStyleTableLightShadingAccent1
            styleName = "__TableLightShadingAccent1"
        Case wdStyleTableLightListAccent1
            styleName = "__TableLightListAccent1"
        Case wdStyleTableLightGridAccent1
            styleName = "__TableLightGridAccent1"
        Case wdStyleTableMediumShading1Accent1
            styleName = "__TableMediumShading1Accent1"
        Case wdStyleTableMediumShading2Accent1
            styleName = "__TableMediumShading2Accent1"
        Case wdStyleTableMediumList1Accent1
            styleName = "__TableMediumList1Accent1"
        Case wdStyleListParagraph
            styleName = "__ListParagraph"
        Case wdStyleQuote
            styleName = "__Quote"
        Case wdStyleIntenseQuote
            styleName = "__IntenseQuote"
        Case wdStyleSubtleEmphasis
            styleName = "__SubtleEmphasis"
        Case wdStyleIntenseEmphasis
            styleName = "__IntenseEmphasis"
        Case wdStyleSubtleReference
            styleName = "__SubtleReference"
        Case wdStyleIntenseReference
            styleName = "__IntenseReference"
        Case wdStyleBookTitle
            styleName = "__BookTitle"
        Case wdStyleBibliography
            styleName = "__Bibliography"
        Case wdStyleTocHeading
            styleName = "__wdStyleTocHeading"
        Case Else
            styleName = wordStyle.NameLocal
    End Select
    
    GetCustomXmlStyleName = styleName
                
End Function

Function GetBooleanString(b As Boolean)

    ' Return a string value used in XML for a boolean

    If b = True Then
        GetBooleanString = "true"
    Else
        GetBooleanString = "false"
    End If

End Function