本文介绍了VBA下标超出范围和错误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)
下面你可以找到代码。如果有人能确定我在哪里出错,我真的很感激。
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)为我工作您错误的最可能原因是您没有在其中一张表格上显示预期名称的表。
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
设置:它可能出现使处理数组更容易,但更改默认数组行为会导致更多的问题,而不是解决。
这篇关于VBA下标超出范围和错误9的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!