Question

我设法将范围从excel复制到新打开的WORD文档并控制行间距（感谢一些帮助Copy range from excel to word - set paragraph spacing to zero）。

但是，当我在打开的现有word文件（document.docx）中将多个范围复制到多个书签时，我无法控制行间距。代码可以在帖子的末尾找到。

此代码适用于包含多个工作表的Excel文件。一张是配置表。它包含包含表格的excel表格的名称（在范围＆＃34;名称＆＃34;中）并将其链接到单词中的书签名称（范围BookmarkExcel＆＃34;）＆＃34;。

我想问题就在于这部分代码：

Set wdTable = myDoc.Tables(myDoc.Tables.Count)
wdTable.Range.ParagraphFormat.SpaceAfter = 0

我尝试了各种各样的变体（例如用rep，1代替myDoc.Tables.Count，......）但是没有设法控制行间距。我做错了什么？

编辑：我找到了原因：文档中已经包含了一些表（在我复制和粘贴的表之前和之后），导致行间距的代码不起作用。因此，我如何调整我的代码，使其适用于已包含表的文档？

Sub ExcelTablesToWord()

Dim tbl             As Range
Dim WordApp         As Word.Application
Dim myDoc           As Word.Document
Dim WordTable       As Word.Table

Sheets("Configuration").Select
n = ActiveSheet.UsedRange.Rows.Count

Set ListTables = Range("Name")
Set ListExcelBookmarks = Range("BookmarkExcel")


Set WordApp = GetObject(class:="Word.Application")
WordApp.Visible = True
Set myDoc = WordApp.Documents("document.docx")

For rep = 2 To n

        SheetName = ListTables.Cells(rep, 1).Value

        On Error Resume Next
        Set existing = Sheets(SheetName)
        existing.Select 'added this

        lastColumn = ActiveSheet.UsedRange.Columns.Count
        LastRow = ActiveSheet.UsedRange.Rows.Count

    If ListExcelBookmarks.Cells(rep, 1).Value <> "" Then

        Set tbl = Range(Cells(1, 1), Cells(LastRow, lastColumn))
        tbl.Copy

        myDoc.Bookmarks(ListExcelBookmarks.Cells(rep, 1).Value).Range.PasteExcelTable _
            LinkedToExcel:=False, _
            WordFormatting:=False, _
            RTF:=False

        Dim wdTable As Table

        Set wdTable = myDoc.Tables(myDoc.Tables.Count)
        wdTable.Range.ParagraphFormat.SpaceAfter = 0

    End If
Next rep
End Sub

Answer 1

将表计数到当前书签，然后添加一个以获取新添加的表索引

这是您的代码，其中包含上述内容以及其他（希望）有用的重构内容：

Option Explicit

Sub ExcelTablesToWord()
    Dim WordApp             As Word.Application
    Dim myDoc               As Word.Document
    Dim wdTable As Table

    Dim rep                 As Long
    Dim ListTables          As Range
    Dim ListExcelBookmarks  As Range
    Dim ws                  As Worksheet
    Dim tabName             As String

    Set WordApp = GetObject(class:="Word.Application")
    WordApp.Visible = True
    Set myDoc = WordApp.Documents("document.docx")

    With Worksheets("Configuration")
        Set ListTables = .Range("Name")
        Set ListExcelBookmarks = .Range("BookmarkExcel")
    End With

    For rep = 2 To ListExcelBookmarks.Rows.Count  '<--| loop through bookmarks range, skipping first row
        If ListExcelBookmarks.Cells(rep, 1).Value <> "" Then
            tabName = ListTables.Cells(rep, 1).Value
            If GetSheet(tabName, ws) Then '<-- GetSheet() returns 'True' if a worksheet named after 'tabName' is found and sets 'ws' to it. Otherwise it returns 'False'
                ws.UsedRange.Copy
                With myDoc
                    .Bookmarks(tabName).Range.PasteExcelTable _
                                                                        LinkedToExcel:=False, _
                                                                        WordFormatting:=False, _
                                                                        RTF:=False
                    Set wdTable = .Tables(.Range(.Range.Start, .Bookmarks(tabName).Range.End).Tables.Count + 1) '<--| add one to the tables before current bookmark to get the newly added one right after it
                    wdTable.Range.ParagraphFormat.SpaceAfter = 0
                End With
            End If
        End If
    Next rep
End Sub

Function GetSheet(shtName As String, ws As Worksheet) As Boolean
    On Error Resume Next
    Set ws = Worksheets(shtName)
    GetSheet = Not ws Is Nothing
End Function

将多个范围从excel复制到word并控制linepacing

1 个答案: