從excel複製多個範圍到word並控制行間距

Question

我設法從excel複製一個範圍到一個新打開的WORD文檔並控制行距（感謝Copy range from excel to word - set paragraph spacing to zero）。

但是，當我將多個範圍複製到打開的和現有的word文件（document.docx）中的多個書籤時，我無法控制行間距。代碼可以在帖子結尾處找到。

此代碼適用於具有多個工作表的Excel文件。一張是配置表。它包含包含表（位於「名稱」範圍內）的Excel工作表的名稱，並將其鏈接到單詞中的書籤名稱（範圍爲BookmarkExcel「）」。

我想這個問題是這塊代碼：

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

我試過各種變化（例如，通過代表，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