VBA下标超出范围和错误9

我知道这个错误已经定义在以前的职位，例如在这里 。 我对VBA相当陌生，并没有真正理解那里的解释。

我正在使用下面的代码自动添加多个表到一个word文档通过书签他们的链接http://www.thespreadsheetguru.com/blog/2014/10/5/multiple-tables-to-word-with -vba 。我得到一个下Subscript out of range (error 9)

通过在Excel表格中select一个特定的范围，我自己手动创build表格。

在这里下面你可以find代码。 我真的很感激，如果有人能确定我哪里出错了。

非常感谢你提前。

---

 Option Base 1 'Force arrays to start at 1 instead of 0 Sub ExcelTablesToWord() 'PURPOSE: Copy/Paste An Excel Table Into a New Word Document 'NOTE: Must have Word Object Library Active in Order to Run _ (VBE > Tools > References > Microsoft Word 12.0 Object Library) 'SOURCE: www.TheSpreadsheetGuru.com Dim tbl As Excel.Range Dim WordApp As Word.Application Dim myDoc As Word.Document Dim WordTable As Word.Table Dim TableArray As Variant Dim BookmarkArray As Variant 'List of Table Names (To Copy) TableArray = Array("Table1", "Table2", "Table3", "Table4", "Table5") 'List of Word Document Bookmarks (To Paste To) BookmarkArray = Array("Bookmark1", "Bookmark2", "Bookmark3", "Bookmark4", "Bookmark5") 'Optimize Code Application.ScreenUpdating = False Application.EnableEvents = False 'Set Variable Equal To Destination Word Document On Error GoTo WordDocNotFound Set WordApp = GetObject(class:="Word.Application") WordApp.Visible = True Set myDoc = WordApp.Documents("Siko_LEFIS_v0.1.docx") On Error GoTo 0 'Loop Through and Copy/Paste Multiple Excel Tables For x = LBound(TableArray) To UBound(TableArray) 'Copy Table Range from Excel tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range '####Here is where i get the subbscipt out of range error####### tbl.Copy 'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5) myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _ LinkedToExcel:=False, _ WordFormatting:=False, _ RTF:=False 'Autofit Table so it fits inside Word Document Set WordTable = myDoc.Tables(x) WordTable.AutoFitBehavior (wdAutoFitWindow) Next x 'Completion Message MsgBox "Copy/Pasting Complete!", vbInformation GoTo EndRoutine 'ERROR HANDLER WordDocNotFound: MsgBox "Microsoft Word file 'Siko_LEFIS_v0.1.docx' is not currently open, aborting.", 16 'Put Stuff Back The Way It Was Found EndRoutine: 'Optimize Code Application.ScreenUpdating = True Application.EnableEvents = True 'Clear The Clipboard Application.CutCopyMode = False End Sub 

Answer 1

下面的代码（对我的环境稍作调整）为我工作。 最可能的原因是您的表单中没有预期名称的表格。

你也失踪在该行上Set （将值分配给对象variables时需要）

 Option Explicit Option Base 1 'Force arrays to start at 1 instead of 0 Sub ExcelTablesToWord() Dim tbl As Excel.Range Dim WordApp As Word.Application Dim myDoc As Word.Document Dim WordTable As Word.Table Dim TableArray As Variant Dim BookmarkArray As Variant Dim x As Long, sht As Worksheet TableArray = Array("Table1", "Table2") BookmarkArray = Array("Bookmark1", "Bookmark2") Application.ScreenUpdating = False Application.EnableEvents = False On Error GoTo WordDocNotFound Set WordApp = GetObject(class:="Word.Application") WordApp.Visible = True Set myDoc = WordApp.Activedocument 'Set myDoc = WordApp.Documents("Siko_LEFIS_v0.1.docx") On Error GoTo 0 For x = LBound(TableArray) To UBound(TableArray) Set sht = ThisWorkbook.Worksheets(x) Set tbl = sht.ListObjects(TableArray(x)).Range myDoc.Bookmarks(BookmarkArray(x)).Range.PasteExcelTable _ LinkedToExcel:=False, _ WordFormatting:=False, _ RTF:=False Set WordTable = myDoc.Tables(x) WordTable.AutoFitBehavior (wdAutoFitWindow) Next x 'Completion Message MsgBox "Copy/Pasting Complete!", vbInformation GoTo EndRoutine 'ERROR HANDLER WordDocNotFound: MsgBox "Microsoft Word file 'Siko_LEFIS_v0.1.docx' is" & _ " not currently open, aborting.", 16 'Put Stuff Back The Way It Was Found EndRoutine: 'Optimize Code Application.ScreenUpdating = True Application.EnableEvents = True 'Clear The Clipboard Application.CutCopyMode = False End Sub 

我还build议您尽量避免使用Option Base 1设置：它可能会使数组处理更容易，但更改默认数组行为会导致比解决问题更多的问题。