Question

我正在尝试将一个命名范围（动态）导出到Word文档表（1）。我可以使用下面的代码来做到这一点（我修改了，但胆量不是我自己的）。

在Word中，我创建了一个1x1表（用于vaDataTbl1）和两个6x6表（用于vaDataTbl2＆3）。我遇到的两个问题是：1）如果范围vaDataTbl1,2或3中的数据大于表，则它仅填充第一列，而不表示有更多信息。我意识到我没有在那里进行错误检查（不确定如何正确放置或正确放置在什么地方），但是我会期望某种运行时错误。 2）我无法确定在列（1）满时将信息放置在列（2）的位置，而在列（2）满时将信息放置在列（3）的位置。 vaDataTbl2＆3中的数据可以在0到100行之间变化。我知道我可以制作更长的单列表，也可以将数据复制并粘贴到表中，但是在处理Word文档和Excel中的动态数据的方式上，我真的很想拆分导出的数据。

我正在使用：Excel2016和Word2016，确保已检查Microsoft Word 16.0对象库（“工具”->“参考”）。我已经找到并阅读了以前发布的代码，用于将（x）by（x）范围导出到（x）by（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

作为选项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

所有代码均已通过临时数据进行了测试。如果我对问题的理解是正确的，则对任何其他问题，反馈，查询表示赞赏。

将Excel范围（+30行）导出到Word表（6x6）的编码问题

1 个答案: