Проблема с кодированием для экспорта диапазона Excel (+30 строк) в таблицу Word (6x6)

Question

Я пытаюсь экспортировать именованный диапазон (динамический) в таблицу документов Word (1).Я могу сделать это с кодом ниже (я изменил, но смелость не моя).

В Word я создал одну таблицу 1x1 (для vaDataTbl1) и две таблицы 6x6 (для vaDataTbl2 & 3).У меня есть две проблемы: 1) Если данные в диапазонах vaDataTbl1,2 или 3 больше, чем таблица, они заполняют только первый столбец без указания на то, что было больше информации.Я понимаю, что там нет проверки ошибок (не уверен, как и где правильно поставить), но я бы ожидал какую-то ошибку времени выполнения.2) Я не могу определить, куда поместить то, что заставляет информацию идти в столбец (2), когда столбец (1) заполнен, и столбец (3), когда столбец (2) заполнен.Данные в vaDataTbl2 & 3 могут варьироваться от 0 до 100 строк.Я знаю, что могу просто создать более длинную таблицу с одним столбцом или скопировать и вставить данные в таблицу, но при работе с документом Word и динамическими данными из Excel мне бы очень хотелось разделить экспортированные данные.

Я работаю с: Excel2016 и Word2016. Я проверил библиотеку объектов Microsoft Word 16.0 (Инструменты-> Ссылки).Я нашел и прочитал ранее опубликованный код для экспорта диапазона (x) по (x) в таблицу (x) по (x), и это может быть вариантом, если не существует простого решения моих проблем.

Sub Export_Table_Data_Word()

'Name of the existing Word document
Const stWordDocument As String = "Data Transfer Testing.docx"

'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell

'Excel objects
Dim wbBook As Workbook
Dim wsSheet As Worksheet

'Count used in a FOR loop to fill the Word table.
Dim lnCountItems As Long


'Variant to hold the data to be exported.
Dim vaDataTbl1 As Variant
Dim vaDataTbl2 As Variant
Dim vaDataTbl3 As Variant

'Initialize the Excel objects
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("WordData")
vaDataTbl1 = wsSheet.Range("A2:A3").Value
vaDataTbl2 = wsSheet.Range("E2:E100").Value
vaDataTbl3 = wsSheet.Range("C2:C53").Value

'Instantiate Word and open the "Table Data Transfer" document.
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\Help Documents\" & stWordDocument)

lnCountItems = 1

'Place the data from the variant into the table 1 in the Word doc.
For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
    wdCell.Range.Text = vaDataTbl1(lnCountItems, 1)
    lnCountItems = lnCountItems + 1
Next wdCell

lnCountItems = 1

'Place the data from the variant into the table 2 in the Word doc.
For Each wdCell In wdDoc.Tables(2).Columns(1).Cells
    wdCell.Range.Text = vaDataTbl2(lnCountItems, 1)
    lnCountItems = lnCountItems + 1
Next wdCell

lnCountItems = 1

'Place the data from the variant into the table 3 in the Word doc.
For Each wdCell In wdDoc.Tables(3).Columns(1).Cells
    wdCell.Range.Text = vaDataTbl3(lnCountItems, 1)
    lnCountItems = lnCountItems + 1
Next wdCell

'Save and close the Word doc.
With wdDoc
    .Save
    .Close
End With

wdApp.Quit

'Null out the variables.
Set wdCell = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing

MsgBox "The " & stWordDocument & "'s table has successfully " & vbNewLine & _
   "been updated!", vbInformation
End Sub

Answer 1

Как прокомментировал @Cindy Meister, вопрос слишком широкий и вариантов несколько. Прежде всего, возможно, стоит работать только со значительными динамическими данными из Excel и ограничивать данные значимыми значениями, используя один из двух простых способов, приведенных ниже

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("WordData")
   'assumed there is no significant data below empty row
    vaDataTbl1 = wsSheet.Range("A2:A" & wsSheet.Range("A2").End(xlDown).Row).Value
   vaDataTbl2 = wsSheet.Range("E2:E" & wsSheet.Range("E2").End(xlDown).Row).Value
   vaDataTbl3 = wsSheet.Range("C2:C" & wsSheet.Range("C2").End(xlDown).Row).Value

    'assumed all rows below significant is empty
    vaDataTbl1 = wsSheet.Range("A2:A" & wsSheet.Range("A" & Rows.Count).End(xlUp).Row).Value
    vaDataTbl2 = wsSheet.Range("E2:E" & wsSheet.Range("E" & Rows.Count).End(xlUp).Row).Value
    vaDataTbl3 = wsSheet.Range("C2:C" & wsSheet.Range("C" & Rows.Count).End(xlUp).Row).Value

Далее рассмотрим Вариант 1 как некоторый механизм проверки ошибок, который вы ожидаете добавить в

Set wdDoc = wdApp.Documents.Open(wbBook.path & "\Help Documents\" & stWordDocument)


        Dim Diff1 As Long, Diff2 As Long, Diff3 As Long, ErrMsg As String
        ErrMsg = ""
        Diff1 = UBound(vaDataTbl1) - wdDoc.Tables(1).Rows.Count
        Diff2 = UBound(vaDataTbl2) - wdDoc.Tables(2).Rows.Count
        Diff3 = UBound(vaDataTbl2) - wdDoc.Tables(3).Rows.Count
        ErrMsg = ErrMsg & IIf(Diff1 > 0, Diff1 & " Rows could not be exported to Table1 " & vbCrLf, "") _
        & IIf(Diff2 > 0, Diff2 & " Rows could not be exported to Table2 " & vbCrLf, "") _
        & IIf(Diff3 > 0, Diff3 & " Rows could not be exported to Table2 " & vbCrLf, "") _

    lnCountItems = 1
    'Place the data from the variant into the table 1 in the Word doc.
    For Each wdCell In wdDoc.Tables(1).Columns(1).Cells
        wdCell.Range.Text = vaDataTbl1(lnCountItems, 1)
        lnCountItems = lnCountItems + 1
    Next wdCell
    If Len(ErrMsg) > 0 Then wdDoc.Tables(1).Cell(1, 1).Range.Comments.Add wdDoc.Tables(1).Cell(1, 1).Range, ErrMsg

Будет добавлен комментарий об ошибке на table1 Cell1 также он может быть добавлен в последний `MsgBox '

MsgBox "The " & stWordDocument & "'s table has " & IIf(Len(ErrMsg) > 0, "partially", "successfully") & " been updated! " & _
    vbCrLf & ErrMsg, vbInformation

Далее следует Вариант 2 в качестве добавления строк в таблицу для размещения всех значимых данных

'Place the data from the variant into the table 1 in the Word doc.
For lnCountItems = 1 To UBound(vaDataTbl1, 1)
If lnCountItems > wdDoc.Tables(1).Rows.Count Then wdDoc.Tables(1).Rows.Add
wdDoc.Tables(1).Cell(lnCountItems, 1).Range.Text = vaDataTbl1(lnCountItems, 1)
Next lnCountItems

For lnCountItems = 1 To UBound(vaDataTbl2, 1)
If lnCountItems > wdDoc.Tables(2).Rows.Count Then wdDoc.Tables(2).Rows.Add
wdDoc.Tables(2).Cell(lnCountItems, 1).Range.Text = vaDataTbl2(lnCountItems, 1)
Next lnCountItems

For lnCountItems = 1 To UBound(vaDataTbl3, 1)
If lnCountItems > wdDoc.Tables(3).Rows.Count Then wdDoc.Tables(3).Rows.Add
wdDoc.Tables(3).Cell(lnCountItems, 1).Range.Text = vaDataTbl3(lnCountItems, 1)
Next lnCountItems

as Вариант 3 Я бы предпочел скорректировать данные в столбцы и строки (добавляются при необходимости). полный код будет что-то вроде

Sub Export_Table_Data_Word()

'Name of the existing Word document
Const stWordDocument As String = "Data Transfer Testing.docx"

'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdCell As Word.Cell

'Excel objects
Dim wbBook As Workbook
Dim wsSheet As Worksheet

'Count used in a FOR loop to fill the Word table.
Dim lnCountItems As Long


'Variant to hold the data to be exported.
Dim vaDataTbl1 As Variant
Dim vaDataTbl2 As Variant
Dim vaDataTbl3 As Variant

'Initialize the Excel objects
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("WordData")
'assumed there is no significant data below empty row
vaDataTbl1 = wsSheet.Range("A2:A" & wsSheet.Range("A2").End(xlDown).Row).Value
vaDataTbl2 = wsSheet.Range("E2:E" & wsSheet.Range("E2").End(xlDown).Row).Value
vaDataTbl3 = wsSheet.Range("C2:C" & wsSheet.Range("C2").End(xlDown).Row).Value

'assumed all rows below significant is empty
'vaDataTbl1 = wsSheet.Range("A2:A" & wsSheet.Range("A" & Rows.Count).End(xlUp).Row).Value
'vaDataTbl2 = wsSheet.Range("E2:E" & wsSheet.Range("E" & Rows.Count).End(xlUp).Row).Value
'vaDataTbl3 = wsSheet.Range("C2:C" & wsSheet.Range("C" & Rows.Count).End(xlUp).Row).Value


'Instantiate Word and open the "Table Data Transfer" document.
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(wbBook.path & "\Help Documents\" & stWordDocument)
'wdApp.Visible = True


Rw = 1
lnCountItems = 1
'Place the data from the variant into the table 1 in the Word doc.
Do While lnCountItems <= UBound(vaDataTbl1, 1)
If Rw > wdDoc.Tables(1).Rows.Count Then wdDoc.Tables(1).Rows.Add
    For Col = 1 To wdDoc.Tables(1).Columns.Count
    wdDoc.Tables(1).Cell(Rw, Col).Range.Text = vaDataTbl1(lnCountItems, 1)
    lnCountItems = lnCountItems + 1
    If lnCountItems > UBound(vaDataTbl1, 1) Then Exit For
    Next Col
Rw = Rw + 1
Loop

Rw = 1
lnCountItems = 1
'Place the data from the variant into the table 2 in the Word doc.
Do While lnCountItems <= UBound(vaDataTbl2, 1)
If Rw > wdDoc.Tables(2).Rows.Count Then wdDoc.Tables(2).Rows.Add
    For Col = 1 To wdDoc.Tables(2).Columns.Count
    wdDoc.Tables(2).Cell(Rw, Col).Range.Text = vaDataTbl2(lnCountItems, 1)
    lnCountItems = lnCountItems + 1
    If lnCountItems > UBound(vaDataTbl2, 1) Then Exit For
    Next Col
Rw = Rw + 1
Loop

Rw = 1
lnCountItems = 1
'Place the data from the variant into the table 3 in the Word doc.
Do While lnCountItems <= UBound(vaDataTbl3, 1)
If Rw > wdDoc.Tables(3).Rows.Count Then wdDoc.Tables(3).Rows.Add
    For Col = 1 To wdDoc.Tables(3).Columns.Count
    wdDoc.Tables(3).Cell(Rw, Col).Range.Text = vaDataTbl3(lnCountItems, 1)
    lnCountItems = lnCountItems + 1
    If lnCountItems > UBound(vaDataTbl3, 1) Then Exit For
    Next Col
Rw = Rw + 1
Loop

'Save and close the Word doc.
With wdDoc
    .Save
    .Close
End With

wdApp.Quit


'Null out the variables.
Set wdCell = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing

MsgBox "The " & stWordDocument & "'s table has successfully " & vbNewLine & _
   "been updated!", vbInformation
End Sub

Все коды проверены с временными данными. Если мое понимание проблемы правильное, любая дополнительная проблема, обратная связь, запрос приветствуются.