1

Excel シート配列 (Udaje) からデータをフィードして、テンプレートからいくつかの単語ドキュメントを入力しようとしています (したがって、例の For )。データの一部を複数のコンテンツ コントロール (テキスト) に同時に挿入したいと考えています。私はタグでそれらを呼び出しており、.Item() を追加して指定する必要があることを知っていますが、コンテンツ コントロールの 1 つだけを更新します。

この制限を克服する方法はありますか? 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 部分を作成/再作成するために使用します (つまり、1 回限りのものです)。

linkedTaggedCcsToCxpsタグ付きコンテンツ コントロールを正しい Cxp/Element にリンク/再リンクするために使用します (これも 1 回限り)。ドキュメントを操作するには、各タグのコンテンツ コントロールを作成し、このルーチンを使用してそれらを接続し、コントロールのオートテキストを作成する方がおそらく簡単です。

に基づいたものを使用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 に答える