Question

我正在尝试从Excel工作表数组（Udaje）提供数据，以从模板填充多个word文档（因此在示例中为For）。我想同时将一些数据插入到几个内容控件（文本）中。我通过标签调用它们，我知道我必须通过添加.Item（）来指定 - 但是我只更新了一个内容控件。

有没有办法克服这个限制？我正在考虑用标签循环标签，但它似乎有点笨拙，因为我不知道有多少标签我必须通过。我是VBA的初学者。

或者我应该使用书签吗？

For i = 1 To LastRow
       '.SelectContentControlsByTag("NapRozhodnuti").Item(1).Range.Text =  Udaje(i, 4)
       .SelectContentControlsByTag("ZeDne").Item(1).Range.Text = Udaje(i, 5)
       .SelectContentControlsByTag("NapadRozkladu").Item(1).Range.Text = Udaje(i, 6)
       .SelectContentControlsByTag("Ucastnik").Item(1).Range.Text = Udaje(i, 2)
       .SelectContentControlsByTag("DatumRK").Item(1).Range.Text = DatumRK
       .SelectContentControlsByTag("NavrhRK").Item(1).Range.Text = NavrhRK
       .SelectContentControlsByTag("OblastRK").Item(1).Range.Text = OblastRK
       .SelectContentControlsByTag("Tajemnik").Item(1).Range.Text = Tajemnik
       .SelectContentControlsByTag("Gender").Item(1).Range.Text = Gender
       .SaveAs2 Filename:= i & " - dokumenty_k_RK.docx", _
            FileFormat:=wdFormatDocument     
Next i

编辑：我最终选择的解决方案是根据索引编号浏览文档中的CC，并根据其标记设置每个CC的值：

For i = 1 To LastRow
   For y = 1 To CCNumber
    Select Case .ContentControls(y).Tag
        Case "NapRozhodnuti"
             .ContentControls(y).Range.Text = Udaje(i, 4)
        Case "ZeDne"
             .ContentControls(y).Range.Text = Udaje(i, 5)
        Case "NapadRozkladu"
             .ContentControls(y).Range.Text = Udaje(i, 6)
        Case "Ucastnik"
             .ContentControls(y).Range.Text = Udaje(i, 2)
        Case "DatumRK"
             .ContentControls(y).Range.Text = DatumRK
        Case "NavrhRK"
             .ContentControls(y).Range.Text = NavrhRK
        Case "OblastRK"
             .ContentControls(y).Range.Text = OblastRK
        Case "Tajemnik"
             .ContentControls(y).Range.Text = Tajemnik
        Case "Gender"
             .ContentControls(y).Range.Text = Gender
    End Select
    Next y
    .SaveAs2 Filename:="..." & i & " - dokumenty_k_RK.docx", _
        FileFormat:=wdFormatDocument
  Next i

编辑：循环代码

...
Set objWord = CreateObject("Word.Application")
 objWord.Visible = True
 objWord.Documents.Open "\\fs1\homes\rostislav.janda\Documents\320\pozvanka_prazdna.docx" 

 With objWord.ActiveDocument 
   Set ccs = .SelectContentControlsByTag("Spznrozkladu")
    LoopCCs ccs, Udaje(i, 1)
   .SaveAs2 Filename:="\\fs1\homes\rostislav.janda\Documents\320\výstup\pozvanka.docx", _
        FileFormat:=wdFormatDocument 'uloží s formátem .docx
   .Saved = True 
 End With
 objWord.Quit 
 Set objWord = Nothing
End Sub


*Sub LoopCCs(ccs As Word.ContentControls, val As String)*
    Dim cc As Word.ContentControl
    For Each cc In ccs
       cc.Range.Text = val
    Next cc
    End Sub

Suprocedure声明行是错误发生的地方。

Answer 1

即使您已经找到了适合您的方法，但这里的提示基于您在问题中提供的起点。您使用SelectContentControlsByTag，然后仅使用.Item(1)寻址找到的第一个控件。

此方法返回内容控件的数组，您不必知道，进入多少：您可以使用For Each循环循环通过数组中的数量。因此，您不需要为每个标记重复循环代码，将其放在单独的过程中，将数组加上要分配给具有相同标记的内容控件的值传递给它。

这样的事情：

With doc
    'Like this
    Set ccs = .SelectContentControlsByTag("test")
    LoopCCs ccs, Udaje(i, 4)
    'Or like this
    LoopCCs  .SelectContentControlsByTag("ZeDne"), Udaje(i, 5)
End With

'Code is VBA and demonstrates the Word object model data types
'For VBS don't declare as types or type as Object
Sub LoopCCs(ccs as Word.ContentControls, val as String)
    Dim cc as Word.ContentControl

    For Each cc In ccs
       cc.Range.Text = val
    Next cc
End Sub

Answer 2

要使用自定义XML部分方式执行此操作，您可以使用以下代码。目前，它需要在一个模块中。

您可以使用replaceAndLinkCxp创建/重新创建必要的自定义XML部件（即它是一次性的）。

您可以使用linkedTaggedCcsToCxps将标记内容控件链接/重新链接到正确的Cxp / Element（也是一次性）。要使用该文档，为每个标记创建内容控件，使用此例程连接它们，然后为控件创建自动文本可能更简单。

您可以使用基于populateCxpData的内容将数据放入Cxp。

有很多假设（例如，所有内容控件都是纯文本，元素名称与标签名称相同）并且有很大的改进空间。

' This should be a name that belongs to you/your organisation
' It should also be unique for each different XML part structure
' you create. i.e. if you have one XML part with elements a,b,c
' and another with elements a,b,d, give them different namespace
' names.
Const sNameSpace = "hirulau"

' Specify the root element name for the part
Const sRootElementName = "ccdata"


Sub replaceAndLinkCxp()
' This deletes any existing CXP with the namespace specified
' in sOldNamespace, and creates a new CXP with the namespace
' in sNamespace. Any data in the CXP is lost.

' Then it links each Content Control with a tag name
' the same as an Element name in the part

' The old namespace (can be the same as the new one)
Const sOldNamespace = "hirulau"

Dim cc As Word.ContentControl
Dim ccs As Word.ContentControls
Dim cxp As Office.CustomXMLPart
Dim cxps As Office.CustomXMLParts
Dim i As Long
Dim s As String

' Specify the number and names of the elements and tags
' Each Element name should be unique, and a valid XML Element name
' and valid Content Control Tag Name
' (No nice way to do this in VBA - could just have a string and split it)

' NB, your CC tag names do not *have* to be the same as the XML Element
' names, but in this example we are making them that way
Dim sElementName(8) As String
sElementName(0) = "NapRozhodnuti"
sElementName(1) = "ZeDne"
sElementName(2) = "NapadRozkladu"
sElementName(3) = "Ucastnik"
sElementName(4) = "DatumRK"
sElementName(5) = "NavrhRK"
sElementName(6) = "OblastRK"
sElementName(7) = "Tajemnik"
sElementName(8) = "Gender"

' remove any existing CXPs with Namespace sOldNamespace

Set cxps = ActiveDocument.CustomXMLParts.SelectByNamespace(sOldNamespace)
For Each cxp In cxps
  cxp.Delete
Next
Set cxps = Nothing
'Debug.Print ActiveDocument.CustomXMLParts.Count

' Build the XML for the part
s = "<" & sRootElementName & " xmlns=""" & sNameSpace & """>" & vbCrLf
For i = LBound(sElementName) To UBound(sElementName)
  s = s & "  <" & sElementName(i) & " />" & vbCrLf
Next
s = s & "</" & sRootElementName & ">"
'Debug.Print s

' Create the Part
Set cxp = ActiveDocument.CustomXMLParts.Add(s)

' For each element/tag name, find the ccs with the tag
' and connect them to the relevant element in the part

For i = LBound(sElementName) To UBound(sElementName)
  For Each cc In ActiveDocument.SelectContentControlsByTag(sElementName(i))
    ' the "map:" is just a local mapping to the correct namespace.
    ' It doesn't have any meaning outside this method call.
    cc.XMLMapping.SetMapping "/map:" & sRootElementName & "/map:" & sElementName(i) & "[1]", "xmlns:map=""" & sNameSpace & """", cxp
  Next
Next

Set cxp = Nothing

End Sub

Sub linkTaggedCcsToCxps()
' Finds our Custom part, then relinks all controls with
' tag names that correspond to its *top level element names*
' So as long as you tag a suitable content control correctly,
' you can use this routine to make it point at the correct Cxp Element
Dim cc As Word.ContentControl
Dim cxn As Office.CustomXMLNode
Dim cxps As Office.CustomXMLParts

' Notice that we need the correct namespace name to do this
Set cxps = ActiveDocument.CustomXMLParts.SelectByNamespace(sNameSpace)
If cxps.Count = 0 Then
  MsgBox "Could not find the expected Custom XML Part."
Else
  ' Iterate through all the *top-level* child Element nodes
  For Each cxn In cxps(1).SelectNodes("/*/*")
    For Each cc In ActiveDocument.SelectContentControlsByTag(cxn.BaseName)
      ' the "map:" is just a local mapping to the correct namespace.
      ' It doesn't have any meaning outside this method call.
      cc.XMLMapping.SetMapping "/map:" & sRootElementName & "/map:" & cxn.BaseName & "[1]", "xmlns:map=""" & sNameSpace & """", cxps(1)
    Next
  Next
End If
Set cxps = Nothing
End Sub

Sub populateCxpData()

Dim sXpPrefix As String

' You would need to populate the following things
Dim i As Integer
Dim Udaje(1, 6) As String
Dim DatumRK As String
Dim NavrhRK As String
Dim OblastRK As String
Dim Tajemnik As String
Dim Gender As String
i = 1
' we need the namespace, but this time assume that we can use
' the first part with that namespace (and that it exists)
With ActiveDocument.CustomXMLParts.SelectByNamespace(sNameSpace)(1)
  sXpPrefix = "/*/" & .NamespaceManager.LookupPrefix(sNameSpace) & ":"
  .SelectSingleNode(sXpPrefix & "NapRozhodnuti[1]").Text = Udaje(i, 4)
  .SelectSingleNode(sXpPrefix & "ZeDne[1]").Text = Udaje(i, 5)
  .SelectSingleNode(sXpPrefix & "NapadRozkladu[1]").Text = Udaje(i, 6)
  .SelectSingleNode(sXpPrefix & "Ucastnik[1]").Text = Udaje(i, 2)
  .SelectSingleNode(sXpPrefix & "DatumRK[1]").Text = DatumRK
  .SelectSingleNode(sXpPrefix & "NavrhRK[1]").Text = NavrhRK
  .SelectSingleNode(sXpPrefix & "OblastRK[1]").Text = OblastRK
  .SelectSingleNode(sXpPrefix & "Tajemnik[1]").Text = Tajemnik
  .SelectSingleNode(sXpPrefix & "Gender[1]").Text = Gender
End With

End Sub

如何一次通过VBS更新多个Word内容控件？

2 个答案: