Word VBA 获取下拉列表数据的代码
Word VBA code to fetch Drop Down list data
我正在尝试在 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 失败。我需要修改一些内容以允许代码获取下拉列表中的条目。
下面是来自同一命令的另一个非常相似的代码，可以运行，但是 returns 来自文本字段的数据而不是保存在 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
如果能帮助修改我的循环代码以获取下拉列表结果，我们将不胜感激。
非常感谢！
如果您尝试从 内容控件中获取文本，您最多需要
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
如果您愿意，甚至可以更进一步。
您目前的代码之所以失败，是因为它实际上是在尝试将文本 放入 内容控件中。您可以使用文本控件来做到这一点，但不能使用下拉列表
（跟进你的评论）如果你想将下拉列表设置为某个值，你基本上必须确定 DropDownListEntries 集合中的哪个项目是正确的，然后 select 它。 ContentControl 中的每个 DropDownListEntry 都有一个唯一的索引、唯一的文本（显示文本）和值（隐藏值）。
您可以通过查看源 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（并且您必须迭代源代码管理的侦听才能做到这一点）。假设它在变量 idx 中。那么你只需要
Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
cc.DropdownListEntries(idx).Select
（事实上你可以一次搞定
doc.SelectContentControlsByTag(TagName)(1).DropDownlistEntries(idx).Select
但我通常发现使用多个语句使调试更容易）。
因此，使用这种方法，您要么必须迭代一组列表条目，要么迭代另一组（或两者，如果您想使用值）。
另一种技术是将控件映射到自定义XML部件中的元素，然后只更新元素值。然后，Word 将该值传播到映射到该元素的所有 ContentControl。有很多东西需要学习，看起来似乎并不复杂，但当您读到最后时，我希望您会明白为什么这实际上是一种非常巧妙的方法。
最简单的情况下，它是这样工作的。假设您的文档中有 一个 DropDown 内容控件。
然后您可以（重新）创建一个 XML 部分并将内容控件映射到它，就像这样。您只需要为文档执行一次 this 代码。如果您的文件是基于模板或从其他文件的副本制作的，那是一次 template/original。
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，而不是索引或文本，您可以这样做 在同一个模块中 所以你设置了 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 倾向于断开内容控件与部件的连接。
但是您可以做的是迭代所有元素和属性节点（例如）并用源中的文本替换目标中的文本。像这样：
' 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(*)] | //@*"select是什么意思？那么，"//*[not(*)]" selects 叶元素（包括具有属性的元素），"//@*" selects 所有属性（始终是叶节点）和 | 是基本上是“或”或“联合”。
我在 Word 中看到的大多数自定义 xml 仅将数据存储在 Elements 中，在这种情况下，您只需要 "//*[not(*)]"
我正在尝试在 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 失败。我需要修改一些内容以允许代码获取下拉列表中的条目。
下面是来自同一命令的另一个非常相似的代码，可以运行，但是 returns 来自文本字段的数据而不是保存在 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
如果能帮助修改我的循环代码以获取下拉列表结果，我们将不胜感激。
非常感谢！
如果您尝试从 内容控件中获取文本，您最多需要
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
如果您愿意，甚至可以更进一步。
您目前的代码之所以失败，是因为它实际上是在尝试将文本 放入 内容控件中。您可以使用文本控件来做到这一点，但不能使用下拉列表
（跟进你的评论）如果你想将下拉列表设置为某个值，你基本上必须确定 DropDownListEntries 集合中的哪个项目是正确的，然后 select 它。 ContentControl 中的每个 DropDownListEntry 都有一个唯一的索引、唯一的文本（显示文本）和值（隐藏值）。
您可以通过查看源 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（并且您必须迭代源代码管理的侦听才能做到这一点）。假设它在变量 idx 中。那么你只需要
Set ccs = doc.SelectContentControlsByTag(TagName)
Set cc = ccs(1)
cc.DropdownListEntries(idx).Select
（事实上你可以一次搞定
doc.SelectContentControlsByTag(TagName)(1).DropDownlistEntries(idx).Select
但我通常发现使用多个语句使调试更容易）。
因此，使用这种方法，您要么必须迭代一组列表条目，要么迭代另一组（或两者，如果您想使用值）。
另一种技术是将控件映射到自定义XML部件中的元素，然后只更新元素值。然后，Word 将该值传播到映射到该元素的所有 ContentControl。有很多东西需要学习，看起来似乎并不复杂，但当您读到最后时，我希望您会明白为什么这实际上是一种非常巧妙的方法。
最简单的情况下，它是这样工作的。假设您的文档中有 一个 DropDown 内容控件。
然后您可以（重新）创建一个 XML 部分并将内容控件映射到它，就像这样。您只需要为文档执行一次 this 代码。如果您的文件是基于模板或从其他文件的副本制作的，那是一次 template/original。
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，而不是索引或文本，您可以这样做 在同一个模块中 所以你设置了 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 倾向于断开内容控件与部件的连接。
但是您可以做的是迭代所有元素和属性节点（例如）并用源中的文本替换目标中的文本。像这样：
' 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(*)] | //@*"select是什么意思？那么，"//*[not(*)]" selects 叶元素（包括具有属性的元素），"//@*" selects 所有属性（始终是叶节点）和 | 是基本上是“或”或“联合”。
我在 Word 中看到的大多数自定义 xml 仅将数据存储在 Elements 中，在这种情况下，您只需要 "//*[not(*)]"