VBA下标超出范围和错误9 [英] VBA Subscript out of range and Error 9

问题描述

我知道这个错误已经在早期的帖子中被定义了。 此处。我对VBA很新，并没有真正理解那里的解释。

I know this error has been defined in earlier posts for e.g. here. I am pretty new to VBA and do not really understand the explanation there.

我正在使用以下代码自动将多个表添加到单词文档中，方法是按照链接我得到一个下标超出范围（错误9）

I am using the following code to automate adding multiple tables to a word document by bookmarking them as explained in the link http://www.thespreadsheetguru.com/blog/2014/10/5/multiple-tables-to-word-with-vba.I am getting a Subscript out of range (error 9)

通过在Excel表单中选择一个特定的范围，自动手动创建表。

The tables are created in the same sheet manually by myself by selecting a particular range in the excel sheet.

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

Here below you can find the code. I would really be grateful if someone can identify where I am going wrong.

提前非常感谢你。

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

推荐答案

下面的代码调整我的envi ronment）为我工作您错误的最可能原因是您没有在其中一张表格上显示预期名称的表。

The code below (some slight tweaks for my environment) worked for me. Most likely cause of your error was that you don't have a table with the expected name on one of your sheets.

您还缺少在该行设置（将值分配给对象变量时需要）

You were also missing Set on that line (required when assigning a value to an object variable)

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 设置：它可能出现使处理数组更容易，但更改默认数组行为会导致更多的问题，而不是解决。

I would also recommend that you try to avoid using the Option Base 1 setting: it might appear to make dealing with arrays easier, but changing the default array behavior causes more problem than it solves.

这篇关于VBA下标超出范围和错误9的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！