Недопустимая погрешность подстроки – vba

Я пытаюсь скопировать и вставить несколько таблиц от Excel к слову, но это дает мне подстрочный код ошибки вне диапазона, когда я пытаюсь определить tbl. Я нашел коды онлайн и пытаюсь изменить коды в соответствии с моими потребностями.

Sub ExcelTablesToWord_Modified() Dim WordApp As Word.Application Dim myDoc As Word.Document Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary") Dim sheet As Excel.Worksheet Dim tableName As String With dict .Add "TableA1", "TableA1" .Add "TableA2", "TableA2" .Add "TableB1", "TableB1" .Add "TableB2", "TableB2" .Add "TableC", "TableC" .Add "TableD", "TableD" .Add "TableE1", "TableE1" .Add "TableE2", "TableE2" .Add "TableF1", "TableF1" .Add "TableF2", "TableF2" 'TODO: add the remaining WorksheetName/TableName combinations End With '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("a.docx") On Error GoTo 0 'Loop Through Worksheets, and Copy/Paste Multiple Excel Tables For Each sheet In ActiveWorkbook.Worksheets tableName = dict(sheet.Name) 'Copy Table Range from Excel sheet.ListObjects(tableName).Range.Copy 'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5) myDoc.Bookmarks(tableName).Range.PasteExcelTable _ LinkedToExcel:=False, _ WordFormatting:=False, _ RTF:=False 'Autofit the most-recently-pasted Table so it fits inside Word Document myDoc.Tables(myDoc.Tables.Count).AutoFitBehavior (wdAutoFitWindow) Next sheet 'Completion Message MsgBox "Copy/Pasting Complete!", vbInformation GoTo EndRoutine 'ERROR HANDLER WordDocNotFound: MsgBox "Microsoft Word file 'b' 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 

введите описание изображения здесь

введите описание изображения здесь

введите описание изображения здесь

Ниже будет скопирована первая таблица на каждом листе и вставьте в документ Word, независимо от имени таблицы. Имена закладок в документе Word, предположительно, начинаются с 1 с префиксом «bookmark».

Если требуются конкретные имена таблиц, тогда создайте коллекцию для имен и пропустите каждую таблицу в каждом листе, если это имя таблицы находится в коллекции, а затем перейдите к копированию.

 Option Base 1 'Force arrays to start at 1 instead of 0 Sub ExcelTablesToWord() Dim oWS As Worksheet Dim tbl As Excel.Range Dim WordApp As Object ' Word.Application Dim myDoc As Object ' Word.Document Dim x As Long ' Integer 'Optimize Code Application.ScreenUpdating = False Application.EnableEvents = False 'Set Variable Equal To Destination Word Document On Error Resume Next Set WordApp = GetObject(, "Word.Application") If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application") If WordApp Is Nothing Then GoTo WordDocNotFound WordApp.Visible = True Set myDoc = WordApp.Documents("a.docx") If myDoc Is Nothing Then Set myDoc = WordApp.Documents.Open("a.docx") If myDoc Is Nothing Then GoTo WordDocNotFound 'Loop Through and Copy/Paste Multiple Excel Tables x = 1 ' For x = LBound(TableArray) To UBound(TableArray) For Each oWS In ThisWorkbook.Worksheets 'Copy Table Range from Excel 'Set tbl = ThisWorkbook.Worksheets(x).ListObjects(TableArray(x)).Range Set tbl = oWS.ListObjects(1).Range If Not tbl Is Nothing Then tbl.Copy 'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5) myDoc.Bookmarks("bookmark" & x).Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False 'Autofit Table so it fits inside Word Document myDoc.Tables(x).AutoFitBehavior 2 ' (wdAutoFitWindow) x = x + 1 End If Next On Error GoTo 0 'Completion Message MsgBox "Copy/Pasting Complete!", vbInformation GoTo EndRoutine 'ERROR HANDLER WordDocNotFound: MsgBox "Microsoft Word file 'b' 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 

Код, который я изначально предоставил, основывался на вашей исходной модели, в которой соответствующий Рабочий лист, Таблица и Закладка в каждом наборе имели другое имя.

Теперь, когда вы убедитесь, что имена объектов в каждом наборе идентичны (что является лучшей моделью), попробуйте выполнить следующую процедуру. Единственное отличие заключается в том, что Scripting.Dictionary был удален, а имя рабочего листа используется для предоставления имени таблицы и имени закладки (так как все три значения совпадают сейчас).

Как и раньше, этот был также протестирован в Excel / Word 2016 и функционирует как ожидалось:

 Public Sub ExcelTablesToWord_Modified2() Dim WordApp As Word.Application Dim myDoc As Word.Document Dim sheet As Excel.Worksheet '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("a.docx") On Error GoTo 0 'Loop Through Worksheets, and Copy/Paste Multiple Excel Tables For Each sheet In ActiveWorkbook.Worksheets 'Copy Table Range from Excel sheet.ListObjects(sheet.Name).Range.Copy 'Paste Table into MS Word (using inserted Bookmarks -> ctrl+shift+F5) myDoc.Bookmarks(sheet.Name).Range.PasteExcelTable _ LinkedToExcel:=False, _ WordFormatting:=False, _ RTF:=False 'Autofit the most-recently-pasted Table so it fits inside Word Document myDoc.Tables(myDoc.Tables.Count).AutoFitBehavior (wdAutoFitWindow) Next sheet 'Completion Message MsgBox "Copy/Pasting Complete!", vbInformation GoTo EndRoutine 'ERROR HANDLER WordDocNotFound: MsgBox "Microsoft Word file 'b' 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 

Если вы по-прежнему получаете ту же ошибку, возможно, рабочая книга повреждена. В этом случае попробуйте сделать следующее:

  1. Создайте новую рабочую книгу с одним рабочим листом
  2. Переименуйте рабочий лист так, чтобы его имя совпадало с именем одного из закладок в документе Word
  3. Вручную добавьте единую, небольшую таблицу «только для тестирования» на рабочий лист (не копируйте и не вставляйте одну из оригинальной книги)
  4. Убедитесь, что имя таблицы совпадает с именем рабочего листа
  5. Скопируйте / вставьте описанную выше процедуру в новый модуль в этой книге
  6. Сохранить новую книгу
  7. Убедитесь, что документ Word открыт, и выполните процедуру

Если это сработает, вы можете рассмотреть возможность воссоздания всей оригинальной книги в новой книге. При этом, если ваши наборы данных достаточно велики, чтобы вы могли скопировать / вставить из оригинальной книги, используйте «Вставить специальный» с «Только значения» вместо обычной вставки. Затем заново создайте любое отсутствующее форматирование вручную. Таким образом, будет менее вероятно, что любая коррупция в оригинальной книге будет перенесена на новую.

  • VBA Excel Отключение оттенков серого в Word Doc
  • Экспорт данных из Excel в Word, пока функция
  • Создание Tabstops в VBA в Excel для файла Word
  • Анализ HTML для воссоздания таблиц в документе Word с использованием VBA
  • Сохранить сгенерированный файл Word с уникальным именем (mailmerge)
  • Как сделать одну форму в текстовом документе открытием нескольких других документов и заполнить идентификационные заголовки в слове / excel?
  • Использование Найти в Word из списка в Excel VBA
  • макрос замены слова в excel не работает
  • VBA, EXCEL, WORD: форматирование горизонтальной линии из Excel в заголовке Word
  • Как ссылаться на CodeName листа Excel из слова?
  • Ссылка на форму слова для Excel
  • Давайте будем гением компьютера.