时间戳

首页 > 解决方案 > 将 Excel 中的行转置为 Word 文档表

excel - 将 Excel 中的行转置为 Word 文档表

问题描述

我在 Excel 中有一个数据库，每个条目水平运行 8 个单元格（例如 A2:H10）。
我正在尝试从每个 8 个单元格条目中创建 Word 文档，这些单元格条目垂直注入到总共 8 个单元格的 Word 文档表中。

这是我尝试过的代码示例。

Sub CreateEntry()

Dim wdApp As Object
Dim wd As Object
Dim myarray As Variant

On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
    Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0

Set wd = wdApp.Documents.Add

wdApp.Visible = True

Sheets("Accommodation").Activate
Set Rng = ThisWorkbook.ActiveSheet.Range("A1:E76")
myarray = Range("A2:H2")
Range("A2:H2").Value = myarray
Range("A40:A48").Value = Application.WorksheetFunction.Transpose(myarray)
Set Rng = ThisWorkbook.ActiveSheet.Range("A40:A48")

Rng.Copy

With wd.Range
    .Collapse Direction:=0
    .InsertParagraphAfter
    .Collapse Direction:=0
    .PasteSpecial False, False, True
End With

End Sub

标签： excelvbams-wordtranspose

解决方案

You can create tables directly in Word using the Word object model. That gives you more control over how it turns out.

Sub CreateEntry()

    Dim doc As Object, rw As Range, tbl As Object
    Dim n As Long
    
    For Each rw In ThisWorkbook.Sheets("Accommodation").Range("A2:H3").Rows
        Set doc = GetWordDoc()
        Set tbl = doc.tables.Add(doc.Range, rw.Cells.Count, 1)
        For n = 1 To rw.Cells.Count
            tbl.Cell(n, 1).Range.Text = rw.Cells(n).Text
        Next n
    Next rw

End Sub

Function GetWordDoc() As Object
    Dim wdApp As Object
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then
        Set wdApp = CreateObject("Word.Application")
        wdApp.Visible = True
    End If
    On Error GoTo 0
    Set GetWordDoc = wdApp.Documents.Add
End Function

推荐阅读