1

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

有没有办法克服这个限制？我正在考虑用 for 循环标签，但它似乎有点笨拙，因为我不知道我必须经过多少标签。我是 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 声明行是错误发生的地方。

4

2 回答 2

2

要使用自定义 XML 部分方式来执行此操作，您可以使用以下代码。就目前而言，它需要位于单个模块中。

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

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

您将使用基于的东西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
于 2016-04-13T13:28:52.690 回答
2

即使您已经找到了适合您的方法，这里有一个基于您在问题中提供的起点的提示。您正在使用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
于 2016-04-12T17:18:42.780 回答