微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

有没有人可以帮助我理解 Word 表单上 XML 映射的 VB 代码?

如何解决有没有人可以帮助我理解 Word 表单上 XML 映射的 VB 代码?

代码附加到我正在处理的字形上的宏。它没有记录在案,据我所知,它的目的是使用表单本身的内容控制字段修改添加一个 xml 文件。我运行宏,它只是关闭了文档,而不对 Word 文件上的 xml 映射执行任何操作。

Sub SetupSections()

    
 On Error GoTo Err
    
    Dim doc As Word.Document
    Set doc = ActiveDocument
    
    doc.VBProject.References.AddFromGuid "{3F4DACA7-160D-11D2-A8E9-00104B365C9F}",1,0
    
    Dim sPathXML As String
    sPathXML = doc.Path & "\empty XML.xml"
    
    Dim present As Boolean
    present = False
    Dim cxp As Office.CustomXMLPart
    For Each part In doc.CustomXMLParts
        root = part.DocumentElement.BaseName
        If root = "certificationAuditResponse" Then
            Set cxp = part
            present = True
        End If
    Next
    
    If Not present Then
        Set cxp = doc.CustomXMLParts.add
        cxp.Load sPathXML
    End If

    Dim ctrl As Word.ContentControl


    Dim rng As Word.Range
    
    Dim controls As ContentControls
    Dim item As ContentControl
     
    Dim rIndex As Integer
    Dim sectionMajor As String
    Dim oldSection As String
    Dim sectionMinor As String
    Dim tag As String
    oldSection = "old section"
    Dim node As CustomXMLNode
    Dim sectionNode As CustomXMLNode
    Dim responseNode As CustomXMLNode
    
    For Each tb In doc.Tables
        Dim rCount
        rCount = tb.Rows.count

        For rIndex = 1 To rCount
            Set rw = tb.Rows(rIndex)
            If rIndex = 1 Then
                sectionMajor = sectionMajorFromString(rw.Cells(1).Range.text)
                If sectionMajor = "" Then
                    GoTo NextIteration
                End If
                If Not sectionMajor = oldSection Then
                    oldSection = sectionMajor
                    Set node = cxp.SelectSingleNode("/certificationAuditResponse/responseBody")
                    node.AppendChildNode ("auditResponseSection")
                    Set sectionNode = node.LastChild
                    sectionNode.AppendChildNode "sectionName",msoCustomXMLNodeAttribute,sectionMajor
                End If
            End If
            If rIndex > 2 And rw.Cells.count > 1 Then
                sectionMinor = sectionMinorFromString(rw.Cells(1).Range.text)
                sectionNode.AppendChildNode ("auditResponse")
                Set responseNode = sectionNode.LastChild
                responseNode.AppendChildNode "requirementName",sectionMinor
                responseNode.AppendChildNode "primaryResponse"
                Set item = rw.Cells(3).Range.ContentControls(1)
                Debug.Print item.XMLMapping.SetMapping _
                    ("/certificationAuditResponse/responseBody/auditResponseSection/auditResponse[@requirementName='" + sectionMinor + "']/primaryResponse",cxp)
                responseNode.AppendChildNode "evidence"
                Set item = rw.Cells(4).Range.ContentControls(1)
                Debug.Print item.XMLMapping.SetMapping _
                    ("/certificationAuditResponse/responseBody/auditResponseSection/auditResponse[@requirementName='" + sectionMinor + "']/evidence",cxp)
            End If
            If rIndex = rCount And rw.Cells.count = 1 Then
                sectionNode.InsertNodeBefore "sectionEvidence",sectionNode.FirstChild
                Set item = rw.Cells(1).Range.ContentControls(1)
                Debug.Print item.XMLMapping.SetMapping _
                    ("/certificationAuditResponse/responseBody/auditResponseSection[@sectionName='" + sectionMajor + "']/sectionEvidence",cxp)
            End If
        Next rIndex
NextIteration:
    Next
                
   
            
        
    
    'Debug.Print doc.SelectContentControlsByTag("sectionalEvidence1").item(1).XMLMapping.SetMapping _
    '    ("/certificationAuditResponse/responseBody/auditResponseSection[@sectionName='1.0']/sectionEvidence",cxp)
'
    'Debug.Print doc.SelectContentControlsByTag("primaryResponse11").item(1).XMLMapping.SetMapping _
    '    ("/certificationAuditResponse/responseBody/auditResponseSection/auditResponse[@requirementName='1.1']/primaryResponse",cxp)
    'Debug.Print doc.SelectContentControlsByTag("evidence11").item(1).XMLMapping.SetMapping _
    '    ("/certificationAuditResponse/responseBody/auditResponseSection/auditResponse[@requirementName='1.1']/evidence",cxp)
        
        
    


    Dim sr As Range
    For Each sr In doc.StoryRanges
        For Each item In sr.ContentControls
            item.LockContentControl = True
        Next
    Next

    Exit Sub
' Exception handling. Show the message and resume.
Err:
        doc.Close False
    
End Sub

如果有人能告诉我为什么它不做任何事情,如何修改它,或者只是告诉我它的意图是什么;那太好了。谢谢。

解决方法

由于错误,您的宏关闭了文档。注释第一行以在错误行上停止宏。

'On Error GoTo Err

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。