循环复制/粘贴NamedCells中的数据从excel到Word

时间:2016-06-29 06:10:10

标签: excel vba excel-vba ms-word

我正在使用Macro从Excel中的NamedCells复制数据,并将它们放在Word模板中的特定书签中。当代码到达Bookmarks行的粘贴数据时,我得到运行时错误9。此外,一些数据被粘贴到模板中但是" Title1"被粘贴在BookmarkTitle2位置并且Title2被粘贴到BookmarkTitle3 ...然后出现运行时错误...

代码如下......

有人能告诉我我做错了吗?

Sub CopyExcelTitlesToWord()

    Dim WordApp As Word.Application
    Dim myDoc As Word.Document
    Dim WordTable As Word.Table
    Dim BookmarkArray As Variant
    Dim Title(1 To 3) As Range
    Dim x As Integer

'List the tables/charts from excel you want to Word
     Set Title(1) = ThisWorkbook.Worksheets("TopPage").Range("Title1")
     Set Title(2) = ThisWorkbook.Worksheets("TopPage").Range("Title2")
     Set Title(3) = ThisWorkbook.Worksheets("TopPage").Range("Title3")


'List of corresponding Word Bookmarks to paste the tables/charts to in Word
     BookmarkArray = Array("BookmarkTitle1", "BookmarkTitle2", "BookmarkTitle3")

'Optimize Code
    Application.ScreenUpdating = False
    Application.EnableEvents = False

'Open Word template
     Set WordApp = CreateObject("Word.Application")
     WordApp.Visible = True

'Open existing template in Word
    Set myDoc = WordApp.Documents.Open("C:\Users\xxx\Desktop\TemplateTest1.docx")

'Loop Through and Copy/Paste Multiple Excel NamedCells
    For x = LBound(Title) To UBound(Title)
    Title(x).Select
    Selection.Copy
     'Paste Title into MS Word (using inserted Bookmarks -> ctrl+shift+F5). 'Name the Bookmarks so they are in Series so they are easy to loop through.
    myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable False, False, True
    Next x
         'Optimize Code
    Application.ScreenUpdating = True
    Application.EnableEvents = True

'Clear The Clipboard
    Application.CutCopyMode = False

End Sub

1 个答案:

答案 0 :(得分:-1)

BookmarkArray将是基于0的数组(0..2) - 请参阅Array函数的Excel帮助。

我建议你改变

Dim Title(1 To 3) As Range

Dim Title(0 To 2) As Range

并相应地更改硬编码索引。