首页 > 解决方案 > VBA Excel 到 Word 问题:尝试从同一行传输多个数据

问题描述

我刚刚进入 VBA,最近尝试从 Excel 到 Word 文档,遵循这篇文章和示例:https ://www.makeuseof.com/tag/integrate-excel-data-word-document/

我正在尝试使用该代码进行一些实验,通过将行、字母和日期从 excel 拉到单词中的“表单”,使用非常简单的代码(仍处于测试的早期阶段等等):

    Private Sub Document_Open()
            Dim objExcel As New Excel.Application    
            Dim exWb As Excel.Workbook
            Set exWb = objExcel.Workbooks.Open("C:\Users\testing.xlsm")

            ThisDocument.row.Caption = exWb.Sheets("Sheet1").Cells(2,1)
            ThisDocument.letter.Caption = exWb.Sheets("Sheet1").Cells(2, 2)
            ThisDocument.date.Caption = exWb.Sheets("Sheet1").Cells(2, 3)            
            Set exWb = Nothing
End Sub

从这个 Excel '表': 在此处输入图像描述 到 Word,所以它看起来像这样: 在此处输入图像描述

我现在要做的是将代码写入如果有多个具有相同数字的行的位置(在图片上,您可以看到第 3 行有三个 3 以及它们各自的字母/日期),它将信息拉入Word 类似于下表:

在此处输入图像描述

如果一个数字相同,我怎么能把它写到哪里,只提取其中一个数字(在这种情况下,只有 1 行#)及其各自的字母和日期,都在一个内。

请让我知道这是否有意义,或者您可以给我任何指导。谢谢!

编辑:添加我正在谈论的表格,我在想这样的事情,它基本上会通过填写空白将excel“行”粘贴到已经制作的表格中。我想看看是否可以为每一行制作一个新表格,同时还包括多行(3、3、3 及其各自的字母等等),就像你在其中一张图片中所做的那样。我希望这是有道理的,并再次感谢所有帮助,我真的很感激。对于下图,左边是 Word,将由 Excel 行填写的表格。 在此处输入图像描述

标签: excelvbams-word

解决方案


对于此解决方案,我使用 Excel 表格 ( ) 而不是 Excel 范围,因为将其转换为具有该属性ListObjects的数组更容易。DataBodyRange打开您的 Excel 文件,选择包含您的数据的范围,然后单击选项卡Format As Table dropdown中的菜单Home,选择其中一种样式。在“格式化为表格”窗口中,选中My table has headers复选框,然后单击OK。保存并关闭它,然后返回 Word。

我更新了原始代码,现在它创建了Bookmarks对象以用作以后放置表格的参考点。然后它为每个 Excel 行生成单独的 Word 表,当第一列中的值重复时,它会被放置在前一个表中。

Sub CreateForm()

    Dim xlApp As New Excel.Application
    
    Dim wb As Excel.Workbook
    Set wb = xlApp.Workbooks.Open(ThisDocument.Path & "\TestFile.xlsx")
    
    Dim ws As Excel.Worksheet
    Set ws = wb.Worksheets("Sheet1")
        
    Dim arrTable As Variant
    arrTable = ws.ListObjects("Table1").DataBodyRange
    
    Dim tbl As Table
    Dim i, previousNumber As Integer
    
    'Create empty paragraphs to be used as reference
    'spots for the tables
    For i = 1 To ws.ListObjects("Table1").ListRows.Count
        Selection.TypeParagraph
        Selection.Bookmarks.Add "Table" & i
    Next
    
    Dim rng As Word.Range
    
    For i = LBound(arrTable) To UBound(arrTable)
        If previousNumber <> arrTable(i, 1) Then
            Set rng = ThisDocument.Bookmarks("Table" & i).Range
            Set tbl = ThisDocument.Tables.Add(rng, 2, 3)
            
            'Header row
            tbl.Cell(1, 1).Range.InsertAfter "Row:"
            tbl.Cell(1, 2).Range.InsertAfter "Letter:"
            tbl.Cell(1, 3).Range.InsertAfter "Date:"
            tbl.Rows(1).Range.Bold = True
            tbl.Borders.Enable = True
            
            'Detail row
            tbl.Cell(2, 1).Range.InsertAfter arrTable(i, 1)
            tbl.Cell(2, 2).Range.InsertAfter arrTable(i, 2)
            tbl.Cell(2, 3).Range.InsertAfter arrTable(i, 3)
        Else
            'Removes the extra paragraph and bookmark since the
            'current row will be placed in the previous table
            Selection.GoTo What:=wdGoToBookmark, Name:="Table" & i
            Selection.EndKey Unit:=wdLine, Extend:=wdExtend
            Selection.Delete Unit:=wdCharacter, Count:=1
            ThisDocument.Bookmarks("Table" & i).Delete
            
            tbl.Cell(2, 2).Range.InsertAfter vbCrLf & arrTable(i, 2)
            tbl.Cell(2, 3).Range.InsertAfter vbCrLf & arrTable(i, 3)
        End If
        
        previousNumber = arrTable(i, 1)
    Next
    
    wb.Close
    Set xlApp = Nothing
    
End Sub

您可以在下图中看到运行此代码后的结果:

结果的屏幕截图。


推荐阅读