从 Excel 粘贴后退出 Word Table

Question

我正在尝试将信息从 excel sheet 复制到新的 word 文档。目前，所有内容都在第一个循环中正确复制，但在下一个循环中粘贴到先前粘贴的 table 中。我已经尝试了各种方法来退出 table 我可以通过搜索找到并且 none 似乎可以解决这个问题。希望有人能帮忙。

Sub createWord()
Dim objWord
Dim objDoc
Dim heading As New DataObject
Dim fileName As String
Dim tableRange As Word.Range
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
fileName = ActiveWorkbook.Name
fileName = Left$(fileName, InStrRev(fileName, ".") - 1) & " Data.doc"
'objDoc.SaveAs fileName:=ThisWorkbook.Path & "\" & fileName
objWord.Visible = True

For i = 4 To Application.Sheets.Count
    Dim k As Integer
    k = ((i - 4) * 4) + 1
    
    heading.SetText ThisWorkbook.Worksheets(i).Cells(1, 4).Value
    heading.PutInClipboard
    objDoc.Paragraphs.Add
    objDoc.Paragraphs(k).Range.Paste
    k = k + 1
    
    
    Call copyGraphAuto(i)
    objDoc.Paragraphs.Add
    objDoc.Paragraphs(k).Range.Paste
    k = k + 1
    
    heading.SetText ThisWorkbook.Worksheets(i).Cells(24, 5).Value
    heading.PutInClipboard
    objDoc.Paragraphs.Add
    objDoc.Paragraphs(k).Range.Paste
    k = k + 1
    
    Call copyTableAuto(i)
    objDoc.Paragraphs.Add
    objDoc.Paragraphs(k).Range.Paste
    
    Set tableRange = objDoc.Tables(k - 3).Range
    tableRange.Collapse Direction:=wdCollapseEnd

    'Exit For
Next i

结束子

Sub copyTableAuto(Optional ByVal sheetNumber As Integer)
Dim ppmCount As Integer
    If sheetNumber = 0 Then sheetNumber = ThisWorkbook.ActiveSheet.Index
    ppmCount = Worksheets(sheetNumber).Range("M4:M9").Cells.SpecialCells(xlCellTypeConstants).Count
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Worksheets(sheetNumber).Range("E29:E" & CStr(ppmCount + 28)).Merge
    Worksheets(sheetNumber).Range("E25:I" & CStr(ppmCount + 28)).Copy
    
End Sub

谢谢

Answer 1

问题是由于您试图维护文档中段落的索引造成的。

当您连续向文档添加数据时，最好也更简单地使用 Word 自己的索引并使用：

objDoc.Paragraphs.Last.Range

从 Excel 粘贴后退出 Word Table

Exiting Word Table after pasting from Excel

excel

vba

ms-word