Question

我正在尝试用Word编写代码，该代码允许我从内容控件下拉列表中获取数据。这些数据是从以前保存的Word文件中提取的，我在脚本开始时引用了该文件（但此处未显示，因为这不是问题）。

我可以将其用于其他类型的内容控制（例如下面的示例），但是我无法弄清楚它对下拉列表的作用。

这是我无效的代码：

For l = 1 To 28
Windows(ReportWindowName).Activate
TagName = "Rating" & l
Set doc = ActiveDocument
Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
cc.Range.Select
ccc = Selection.Text
OriginalDocument.Activate
TagName = "Rating" & l
Set doc = ActiveDocument
Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
cc.Range.Select
Selection.Text = ccc
Next l

代码落在Selection.Text上。我需要修改一些内容，以允许代码提取下拉列表中的条目。

下面是来自同一命令的另一个非常相似的代码，该代码有效，但是从文本字段返回数据，而不是从保存在dame文件中的下拉列表中返回数据：

For j = 1 To 6
Windows(ReportWindowName).Activate
TagName = "Mandatory" & j
Set doc = ActiveDocument
Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
cc.Range.Select
ccc = Selection.Text
OriginalDocument.Activate
TagName = "Mandatory" & j
Set doc = ActiveDocument
Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
cc.Range.Select
Selection.Text = ccc
Next j

将感谢您对修改我的循环代码以获取下拉列表结果的任何帮助。

非常感谢！

Answer 1

如果您尝试从内容控件获取文本，则最多只需

Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
' Let's just show the "display name"
Debug.Print cc.Range.Text

您可以将其缩短为

Set ccs = doc.SelectContentControlsByTag(TagName)
' Let's just show the "display name"
Debug.Print ccs(1).Range.Text

，如果您愿意，甚至更进一步。

此刻您的代码失败的原因是，它实际上是试图将文本放入内容控件。您可以使用Text控件来做到这一点，但不能使用下拉列表

（在评论中跟进）如果要将下拉列表设置为某个值，则基本上必须确定DropDownListEntries集合中的哪个项目是正确的，然后选择它。 ContentControl中的每个DropDownListEntry都有唯一的索引，唯一的Text（显示文本）和Value（隐藏值）。

您可以通过查看源ContentControl的.Range.Text从下拉菜单中获取文本，但是您不能将其用作目标ContentControl的列表条目的索引，因此您可以必须迭代：

因此，如果ccc包含要显示的文本，则需要类似

Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
' This asumes you know this is a dropdown list cc
Dim ddle as Word.ContentControlListEntry
For Each ddle in cc.DropdownListEntries
  If ddle.Text = ccc Then
    ddle.Select
    Exit For
  End If
Next

或者，您可以从源控件中获取 Index （并且您必须迭代源控件的listentries来做到这一点）。假设它在变量idx中。然后，您只需要

Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
cc.DropdownListEntries(idx).Select

（实际上，您可以一次完成所有操作

doc.SelectContentControlsByTag(TagName)(1).DropDownlistEntries(idx).Select

但是我通常发现使用多个语句使调试更加容易。

因此，使用这种方法，您要么必须迭代一组列表条目，要么要迭代另一组列表条目（或者，如果要使用“值”，则要迭代两组）。

另一种技术是将控件映射到CustomXMLPart中的Element并仅更新Element值。然后，Word将值传播到映射到该Element的所有ContentControl。有很多东西需要学习，而且看起来似乎不需要复杂，但是到最后我希望您会明白为什么这实际上是一种整洁的方法。

最简单的说，就是这样。假设您的文档中有一个 DropDown内容控件。

然后，您可以（重新）创建XML Part并将内容控件映射到它。您只需为文档执行一次这段代码。如果您的文档是基于模板的或由其他文档的副本制作的，则仅用于模板/原始文档。

Option Explicit
' A namespace URI can just be  a piece of text, but its better if you can use
' something that you "own" such as a domain name.
' There is nothing special about this name.
Const myNameSpace As String = "myns0"

Sub recreateCXPandMapCCs()
Dim ccs As Word.ContentControls
Dim cxp As Office.CustomXMLPart
Dim i As Integer
Dim r As Word.Range
Dim s As String
' There is nothing special about these element names.
' You can use your own
s = ""
s = s & "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
s = s & "<ccvalues1 xmlns='" & myNameSpace & "'>" & vbCrLf
s = s & "  <dropdown1/>" & vbCrLf
s = s & "</ccvalues1>"

With ActiveDocument
  ' select and delete any existing CXPs with this namespace
 For Each cxp In .CustomXMLParts.SelectByNamespace(myNameSpace)
    cxp.Delete
  Next
  
  ' Create a new CXP
  Set cxp = .CustomXMLParts.Add(s)

  ' Connect your dropdown. Instead, you can do this manually in the XML Mapping
  ' Pane in the Developer tab

  ' For an XML Part that only has one namespace the prefix mapping should always be "ns0". 
  .ContentControls(1).XMLMapping.SetMapping "/ns0:ccvalues[1]/ns0:dropdown1[1]", , cxp
  Set cxp = Nothing
End With
End Sub

然后，要设置DropDown的值（它必须是隐藏的 Value ，而不是索引或文本，您可以在同一模块中执行类似的操作< / em>，所以您已经设置了myNameSpace常量。假设您要设置常量值“ xyzvalue”

Sub populateDropdown1Element() With ActiveDocument.CustomXMLParts.SelectByNamespace(myNameSpace)(1) .SelectSingleNode("/ns0:ccvalues1[1]/ns0:dropdown1[1]").Text = "xyzvalue" End With End Sub

当然，如果源文档具有相同的映射，则可以从源文档的XML中的相同元素获取源文档下拉列表的值。事实是，如果您具有相同的XML，相同的映射等，则理想情况下，您应该能够用“源”文档中的一个替换整个目标文档中的CustomXMLPart。发明CustomXMLParts的原因之一是允许使用Office Open XML SDK的人们做到这一点。不幸的是，在打开文档的情况下，它在VBA中不起作用，因为Word倾向于断开内容控件与零件的连接。

但是您可以做的是迭代所有Element和Attribute节点（例如），并将目标中的文本替换为源中的文本。像这样：

' You would need to pass in a reference to the document you want to get your data *from* Sub replaceXML(sourceDocument As Word.Document) Dim s As String Dim cxn As Office.CustomXMLNode Dim sourcePart As Office.CustomXMLPart ' You still need that definition of "myNameSpace" Set sourcePart = sourceDocument.CustomXMLParts.SelectByNamespace(myNameSpace)(1) With ActiveDocument For Each cxn In .CustomXMLParts.SelectByNamespace(myNameSpace).Item(1).SelectNodes("//*[not(*)] | //@*") cxn.Text = sourcePart.SelectSingleNode(cxn.XPath).Text Next End With End Sub

"//*[not(*)] | //@*"选择什么？好吧，"//*[not(*)]"选择叶子元素（包括具有属性的元素），"//@*"选择所有属性（始终是叶子节点），|基本上是“或”或“联合”。 / p>
我在Word中看到的大多数自定义xml只将数据存储在Elements中，在这种情况下，您只需要"//*[not(*)]"

Word VBA代码以获取下拉列表数据

1 个答案: