Question

我正在编写一个代码，我需要将数据从excel复制到几个word文档。我试图定义每个工作文档，然后通过在excel列中引用对象名称来设置循环。这是我的代码：

Sub CopyDatatoWord()

Dim wb As Workbook
Dim ws As Worksheet

Dim CWDoc As Word.Document
Dim EPLDoc As Word.Document
Dim ECNDoc As Word.Document
Dim EPrepDoc As Word.Document
Dim RefDoc As Word.Document
Dim SLabelDoc As Word.Document
Dim LLabelDoc As Word.Document

Dim ObjectNames(13 To 19) As String
ObjectNames(13) = "CWDoc"
ObjectNames(14) = "EPLDoc"
ObjectNames(15) = "ECNDoc"
ObjectNames(16) = "EPrepDoc"
ObjectNames(17) = "RefDoc"
ObjectNames(18) = "SLabelDoc"
ObjectNames(19) = "LLabelDoc"
Dim wdApp As Word.Application
Dim myrange As Range

Set wb = Workbooks("Create Health Fair Forms.xlsm")
Set ws = wb.Worksheets("Data")

Set wdApp = CreateObject("Word.Application")
Set sel = wdApp.Selection


MkDir ("" & ws.Range("FilePath").Value & "")

For k = 13 To 19
    wdApp.DisplayAlerts = wdAlertsNone
    'The next two lines is where the problem is. The second part of the lines work, but first part (ws.Cells(k,47.Value) does not. 
    Set ws.Cells(k, 47).Value& = wdApp.Documents.Open(ws.Cells(k, 49).Value)'This is the line where I get the error
    ws.Cells(k, 47).Value&.SaveAs (ws.Cells(k, 48).Value)
    wdApp.DisplayAlerts = wdAlertsAll
    wdApp.Visible = True


    For i = 13 To 41

        wdApp.Selection.Find.ClearFormatting
        wdApp.Selection.Find.Replacement.ClearFormatting
        With wdApp.Selection.Find
            .Text = ws.Cells(i, 45).Value
            .Replacement.Text = ws.Cells(i, 44).Value
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
         End With
             wdApp.Selection.Find.Execute Replace:=wdReplaceAll

    Next i

Next k

MsgBox "You are all done!"

End Sub

它给了我错误＆＃34;运行时错误438;对象不支持此属性或方法＆＃34;

我也尝试将值放在数组中，但这也不起作用。其余的代码工作正常。任何帮助将不胜感激。

如何在VBA中循环对象

0 个答案: