将Excel数据写入Word内容控件而不会出现错误消息

时间:2018-12-20 18:33:34

标签: vba ms-word word-contentcontrol

这个问题是关于使用内容控件将数据值从Excel移到VBA中的Word。请注意,我已经在MSExcel VBA环境中的引用下启用了“ Microsoft Word 16.0对象库”。

我的项目需要将Excel数据发送到Word文档中的特定位置。

问题:似乎我没有正确使用contentcontrols,并不断遇到运行时错误,但我没有找到太多相关信息。要么RTE-438

  

对象不支持此方法

或RTE-424

  

需要对象

代码作用说明:有两个带有多个工作表的基准工作簿。另一本分析工作簿使用VLOOKUP(INDIRECT ...)对每一个进行编程,以生成用于将报告放入Word文档的表格。变量用于更改基准工作簿中来源的选项卡。分析基本上是CATS-DOGS = PETS。在每个循环中,将跳过没有信息的表(两个基准工作簿之间没有差异),并分析下一个选项卡。如果表格有用,则生成PDF。该报告(Word文档)已更新。表已添加到报告中。完成后,将考虑下一个选项卡或评估表。

Sub CommandButton1_Click()

Dim Tabs(0 To 18) As Variant
Tabs(0) = "01"
Tabs(1) = "02"
Tabs(2) = "03"
Tabs(3) = "03"
Tabs(4) = "04"
Tabs(5) = "05"
Tabs(6) = "06"
Tabs(7) = "07"
Tabs(8) = "08"
Tabs(9) = "09"
Tabs(10) = "10"
Tabs(11) = "11"
Tabs(12) = "12"
Tabs(13) = "13"
Tabs(14) = "14"
Tabs(15) = "15"
Tabs(16) = "16"
Tabs(17) = "17"
Tabs(18) = "18"

Dim xlApp As Object
On Error Resume Next
    Set xlApp = GetObject("excel.applicaiton")
If Err.Number = 429 Then
    Err.Clear
    Set xlApp = CreateObject("excel.applicaiton")
End If
On Error GoTo 0

Dim controlThis As String ' the controlThis variable is to the address of the particular data unit that should be passed to a word.documents.contentcontrols to update the text in the word document based on the change in the actual data.

Dim NetworkLocation As String
NetworkLocation = "\\myServer\myFolder\mySubfolder\"

Dim CATS As String
CATS = "kittens.xlsx"
Excel.Application.Workbooks.Open FileName:=(NetworkLocation & "Other Subforder\ThisWway\" & CATS)

Dim DOGS As String
DOGS = "puppies.xlsx"
Excel.Application.Workbooks.Open FileName:=(NetworkLocation & "differentSubfolder\ThatWay\" & DOGS)
'Populates the array with analysis tables

Dim Temples As Object
Dim Template(3 To 9) As Variant
Template(3) = "\3\EVAL Table 3.xlsx"
Template(4) = "\4\EVAL Table 4.xlsx"
Template(5) = "\5\EVAL Table 5.xlsx"
Template(6) = "\6\EVAL Table 6.xlsx"
Template(7) = "\7\EVAL Table 7.xlsx"
Template(8) = "\8\EVAL Table 8.xlsx"
Template(9) = "\9\EVAL Table 9.xlsx"


Dim strXLname As String
Dim opener As Variant
    For Each opener In Template
        strXLname = NetworkLocation & "Other Subfolder\EVAL Tables\WonderPets" & opener
        Excel.Application.Workbooks.Open FileName:=strXLname

Dim currentDiffernce As Long
currentDifference = ActiveSheet.Cells(5, 6).Value
'This code cycles through the different EVAL Table templates

    ActiveSheet.Cells(1, 1).Value = CATS
    ActiveSheet.Cells(2, 1).Value = DOGS

        Dim k As Variant
        For Each k In Tabs
            controlThis = k & "-" & eval  'passes a string to the wdApp.contentcontrol
            ActiveSheet.Rows.Hidden = False
            ActiveSheet.Cells(1, 4).Value = k  'initialize k
            ActiveSheet.Calculate
            DoEvents
            currentDifference = ActiveSheet.Cells(5, 6).Value  'stop blank tables from being produced using the total delta in the preprogrammed spreadsheet
            If currentDifference = 0 Then  'since the total difference in the current analysis is 0 this bit of code skips to the next WonderPet
                Else
                    controlThis = k & "-" & opener  '(Was eval as variant used with thisTable array)passes a string to the wdApp.contentcontrol
                    Call PDFcrate  'Print the Table to a PDF file. Worked well and was made a subroutine.
                        Dim objWord As Object
                        Dim ws As Worksheet
                        'Dim cc As Word.Application.ContentControls
                        Set ws = ActiveWorkbook.Sheets("Sheet1")
                        Set objWord = CreateObject("Word.Application")
                        objWord.Visible = True
                        objWord.Documents.Open FileName:="myFilePath\Myfile.docx", noencodingdialog:=True ' change as needed

                        With objWord.ActiveDocument
                .ContentControls(controlThis & " cats").Range.Text = eval.ActiveSheet.Cells(5, 4) 'These are the updates to the report for each content control with the title. Substituting SelectContentControlsByTitle() gives RTE-424 'Object Required'
                .ContentControls(controlThis & " dogs").Range.Text = eval.ActiveSheet.Cells(5, 5)
                .ContentControls(controlThis & " pets").Range.Text = eval.ActiveSheet.Cells(5, 6)
                .ContentControls(controlThis & " Table).range. = 'Need to add the PDF to the report, perhaps using an RichTextConentConrols...additional suggestions welcomed (haven't researched it yet).
                        End With

                    Set objWord = Nothing
                    Word.Application.Documents.Close SaveChanges:=True 'Saves and Closes the document
                    Word.Application.Quit 'quits MS Word
            End If

        Next  'repeats for each tab with name "k" in the workbooks
Excel.Application.Workbooks(strXLname).Close
    Next  'repeat for each evalTable
Excel.Application.Workbooks(CATS).Close
Excel.Application.Workbooks(DOGS).Close

End Sub

2 个答案:

答案 0 :(得分:1)

无法使用字符串作为其他方法的索引值来获取Word的内容控件。问题中的代码示例的以下行不起作用:

.ContentControls(controlThis & " cats").Range.Text = eval.ActiveSheet.Cells(5, 4)

ContentControl的唯一有效索引值为ID,这是在生成ContentControl时Word应用程序分配的长号(GUID)。

这样做的原因是多个内容控件可以具有相同的Title(名称)和/或Tag。由于此信息不是唯一的,因此不能用于拾取单个内容控件。

相反,代码需要使用Document.SelectContentControlsByTitleDocument.SelectContentControlsByTag。它们返回符合指定标准的内容控件的 collection 。例如:

Dim cc as Word.ContentControls ' As Object if late-binding is used
With objWord.ActiveDocument
    Set cc = .SelectContentControlsByTitle(controlThis & " cats")
    'Now loop all the content controls in the collection to work with individual ones
End With

如果可以肯定,Title仅包含一个内容控件,或者只需要第一个,则可以这样做:

Dim cc as Word.ContentControl ' As Object if late-binding is used
With objWord.ActiveDocument
    Set cc = .SelectContentControlsByTitle(controlThis & " cats").Item(1)
    cc.Range.Text = eval.ActiveSheet.Cells(5, 4)
End With

提示1:使用ActiveDocument被认为不是Word的好习惯。与Excel中的ActiveCell(或其他任何东西)一样,不确定“活动”的东西是否应该被操纵。使用对象更可靠,在这种情况下,可以将对象直接分配给正在打开的文档。根据问题中的代码:

Dim wdDoc as Object 'Word.Document
Set wdDoc = objWord.Documents.Open(FileName:="myFilePath\Myfile.docx", noencodingdialog:=True)
With wdDoc  'instead of objWord.ActiveDocument

提示2:由于问题中的代码针对的是多个内容控件,而不是声明多个内容控件对象,因此将标题和值放在数组中并使其循环可能更有效。

答案 1 :(得分:0)

此问题已解决...循环可能是让我感到困惑的事情。 复数ContentControls或单数ContentControl的使用似乎并不重要。我的下一个技巧是将表格放入word文档中...有什么想法吗?

Set wdDoc = Word.Application.Documents(wdDocReport)  
Dim evalData(0 To 2) As Variant  
evalData(0) = " CATS"  
evalData(1) = " DOGS"  
evalData(2) = " PETS"  

Dim j As Variant  
Dim i As Integer  
i = 4  
For Each j In evalData  
    Dim cc As Word.ContentControls   
    With Word.Application.Documents(wdDocReport)  
             .SelectContentControlsByTitle(controlThis & j).Item  (1).Range.Text = ActiveWorkbook.ActiveSheet.Cells(5, i).Value  
        i = i + 1  
    End With  
    Next  
Word.Application.Documents.Close SaveChanges:= True
Word.Application.Quit

只有一个工作表集中关注,因此ActiveWorkbook和ActiveWorksheet不会在这里伤害我