VBA下标超出范围和错误9

Question

我知道此错误已在较早的文章中定义，例如here 。 我对VBA还是很陌生，不十分了解那里的解释。

我正在使用以下代码通过将它们添加为书签将多个表自动添加到Word文档中，如链接http://www.thespreadsheetguru.com/blog/2014/10/5/multiple-tables-to-word-with中所述-vba 。我的下Subscript out of range (error 9)

这些表是由我自己通过在excel工作表中选择特定范围手动在同一工作表中创建的。

您可以在下面找到代码。 如果有人能确定我要去哪里错了，我将不胜感激。

提前非常感谢您。

---

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 （将值分配给对象变量时需要）

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

我还建议您避免使用Option Base 1设置：它看起来似乎使处理数组更容易，但是更改默认数组行为会导致更多问题，而不是解决的问题。