複数の範囲をExcelからWordにコピーし、行間を制御する

Question

Excelから新しく開いたWORDドキュメントに範囲をコピーし、行間を制御することができます（いくつかのヘルプCopy range from excel to word - set paragraph spacing to zeroのおかげで）。

しかし、開かれた既存の単語ファイル（document.docx）内の複数の範囲を複数のブックマークにコピーすると、行間を制御できません。このコードは、記事の最後にあります。

このコードは、複数のシートを含むExcelファイルで使用できます。 1枚は構成シートです。これは、テーブルを含むExcelシートの名前（範囲 "名前"）を含み、これをブックマーク名にword（範囲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

ここで上記のものを、いくつかの他の（たぶん）便利なリファクタリングを使用してコードです新しく追加されたテーブルインデックス

を取得するために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