想要将表格列表从Excel复制到Word

Want to Copy List of Tables from Excel to Word

提问人:Flabbergasted_Always 提问时间:11/17/2023 最后编辑:Tim WilliamsFlabbergasted_Always 更新时间:11/17/2023 访问量:44

问:

我是Excel VBA的新手,对编码也不太了解,并且面临这个问题 -

我正在尝试将单个工作表中的表格列表复制到 word,但是表格被粘贴在文档的开头,有没有办法粘贴到书签上,代码也可以包含从 VBA 本身格式化的方式。

Sub ListObjectToWord_Multi()

    'Declare Word Variables
    Dim WrdApp As Object
    Dim WrdDoc As Word.Document
    Dim WrdTbl As Word.Table
    
    'Declare Excel Variables
    Dim ExcLisObj As ListObject
    Dim WrkSht As Worksheet
    
    'Create a new instance of word
    Set WrdApp = CreateObject("Word.Application")
    
    With WrdApp
        .Visible = True
        .Documents.Open Range("F3").Value
        .Activate
    
   'Loop through all the Worksheets in Active Workbook
    For Each WrkSht In ThisWorkbook.Worksheets
        
        'Loop thorugh all objects on the active sheet
        For Each ExcLisObj In WrkSht.ListObjects
        
        'Copy the List Object
        ExcLisObj.Range.Copy
        
        'Pause the excel Application for few seconds
        Application.Wait Now() + #12:00:03 AM#
        
        'Go to New Page
        WrdApp.Selection.GoTo What:=wdGoToBookmarks, Which:=wdGoTo
        
        'Paste List Objects into the word document
        With WrdApp.Selection
             .PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True
        End With
        
        'Clear my Clipboard
        Application.CutCopyMode = False
        
        Next
    
    'Go to First Page
    WrdApp.Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst
    
    Next
    
    End With
    
End Sub

这是我使用的代码,请帮助提供任何可以解决我问题的见解

Excel的

评论

0赞 taller 11/17/2023
请澄清 的含义。是否要在Word中的第一个书签之后粘贴所有excel表格。code contain manner to format
0赞 Flabbergasted_Always 11/17/2023
在下一个书签之后

答:

0赞 taller 11/17/2023 #1

请尝试。

Option Explicit
Sub ListObjectToWord_Multi()
    'Declare Word Variables
    Dim WrdApp As Object
    Dim WrdDoc As Word.Document
    Dim WrdTbl As Word.Table
    'Declare Excel Variables
    Dim ExcLisObj As ListObject
    Dim WrkSht As Worksheet
    Dim i As Long, bmCount As Long
    'Create a new instance of word
    Set WrdApp = CreateObject("Word.Application")
    '    Set WrdApp = GetObject(, "Word.Application")
    With WrdApp
        .Visible = True
        .Documents.Open Range("F3").Value
        Set WrdDoc = .ActiveDocument
        bmCount = WrdDoc.Bookmarks.Count
    End With
    i = 1
    'Loop through all the Worksheets in Active Workbook
    For Each WrkSht In ThisWorkbook.Worksheets
        'Loop thorugh all objects on the active sheet
        For Each ExcLisObj In WrkSht.ListObjects
            If i > bmCount Then
                MsgBox "The count of bookmarks is less than listbox."
                Exit Sub
            Else
                WrdApp.Selection.GoTo What:=wdGoToBookmark, Name:=WrdDoc.Bookmarks(i).Name
            End If
            'Paste List Objects into the word document
            With WrdApp.Selection
                .Collapse wdCollapseEnd
                ExcLisObj.Range.Copy
                'Pause the excel Application for few seconds
                ' Application.Wait Now() + TimeSerial(0, 0, 1)
                .PasteExcelTable LinkedToExcel:=True, WordFormatting:=True, RTF:=True
            End With
            'Clear my Clipboard
            Application.CutCopyMode = False
            i = i + 1
        Next
    Next
    'Go to First Page
    WrdApp.Selection.HomeKey Unit:=wdStory
End Sub

评论

0赞 Flabbergasted_Always 11/17/2023
非常感谢你,代码完全按照预期的方式工作,真的很感谢你的帮助,你真的把我从束缚中拯救出来,谢谢你帮助我。