如何解决有没有人可以帮助我理解 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 举报,一经查实,本站将立刻删除。