Excel VBA分页符

我有一个工作簿完整的工作表我试图复制和粘贴到word文档的内容。 现在代码循环遍历所有的工作表，并将它们粘贴到一个word文档中，但是在另一个之上。 我不得不改变wdDoc.Range(wdDoc.Characters.Count - 1).Paste到wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False我不确定这是否是源问题; 它似乎正在创build一个新的页面，但下一个工作表的内容只是没有被粘贴到它。 我没有收到任何错误消息。 任何意见，将不胜感激！

 Sub toWord() Dim ws As Worksheet Dim fromWB As Variant Dim wdApp As Object Dim wdDoc As Object Dim docName As Variant Dim rng As Range Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Set wdApp = CreateObject("Word.Application") wdApp.Visible = True Set wdDoc = wdApp.Documents.Add wdDoc.Activate 'Creates InputBox that allows user to enter name to save document as docName = Application.InputBox(Prompt:="Enter Document Name", Title:="Save Word Document", Type:=2) wdDoc.SaveAs2 fileName:=docName, FileFormat:=wdFormatDocument 'Saves document under user-provided name fromWB = Application.GetOpenFilename(FileFilter:="Excel Workbook(*.xlsx),*.xlsx", Title:="Open Merged Data") If fromWB <> False Then Set fromWB = Workbooks.Open(fromWB) ElseIf fromWB = False Then MsgBox "No File Selected" GoTo ResetSettings End If For Each ws In fromWB.Worksheets ws.Activate ws.Range("A1:A2").Select Selection.Copy Set wdApp = GetObject(, "Word.Application") wdApp.Visible = True wdDoc.Activate wdDoc.Range.Paste ws.Activate If ws.Range("A3").Value <> "" Then Range("A2").CurrentRegion.Offset(2).Resize(Range("A2").CurrentRegion.Rows.Count - 2).Select Selection.Columns.AutoFit Selection.Copy Set wdApp = GetObject(, "Word.Application") wdApp.Visible = True wdDoc.Activate wdApp.Selection.EndKey Unit:=wdStory wdApp.Selection.MoveDown Unit:=wdLine, Count:=1 wdApp.Selection.TypeParagraph wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter wdDoc.Range.Collapse Direction:=0 wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7 End If Next ws wdDoc.Styles("Normal").NoSpaceBetweenParagraphsOfSameStyle = True wdDoc.Save Set wdDoc = Nothing Set wdApp = Nothing Set fromWB = Nothing MsgBox "Imported into Word Document" ResetSettings: Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub 

Answer 1

testing时占位符编辑：

 Sub asdf() Dim ws As Worksheet Const wdStory = 6 Const wdMove = 0 For Each ws In ThisWorkbook.Worksheets ws.Range("A7").Copy Set docApp = GetObject(, "Word.Application") Set doc = docApp.Documents.Open("PATH OF FILE") docApp.Selection.EndKey wdStory docApp.Selection.PasteAndFormat wdPasteDefault Next ws End Sub 

Answer 2

这是我得到的代码：

 Sub toWord() Dim ws As Worksheet Dim fromWB As Variant Dim wdApp As Object Dim wdDoc As Object Dim docName As Variant Dim rng As Range Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False Set wdApp = CreateObject("Word.Application") wdApp.Visible = True Set wdDoc = wdApp.Documents.Add wdDoc.Activate 'Creates InputBox that allows user to enter name to save document as docName = Application.InputBox(Prompt:="Enter Document Name", Title:="Save Word Document", Type:=2) wdDoc.SaveAs2 fileName:=docName, FileFormat:=wdFormatDocument 'Saves document under user-provided name fromWB = Application.GetOpenFilename(FileFilter:="Excel Workbook(*.xlsx),*.xlsx", Title:="Open Merged Data") If fromWB <> False Then Set fromWB = Workbooks.Open(fromWB) ElseIf fromWB = False Then MsgBox "No File Selected" GoTo ResetSettings End If For Each ws In fromWB.Worksheets ws.Activate ws.Range("A1:A2").Select Selection.Copy Set wdApp = GetObject(, "Word.Application") wdApp.Visible = True wdDoc.Activate wdDoc.Range(wdDoc.Characters.Count - 1).Paste ws.Activate If ws.Range("A4").Value <> "" Then Application.Intersect(ws.UsedRange, ws.Cells.Resize(ws.Rows.Count - 2).Offset(2)).Select Selection.Columns.AutoFit Selection.Copy Set wdApp = GetObject(, "Word.Application") wdApp.Visible = True wdDoc.Activate wdApp.Selection.EndKey Unit:=wdStory wdApp.Selection.MoveDown Unit:=wdLine, Count:=1 wdApp.Selection.TypeParagraph wdDoc.Range(wdDoc.Characters.Count - 1).PasteExcelTable False, False, False wdApp.Selection.Tables(1).Rows.Alignment = wdAlignRowCenter wdApp.Selection.Collapse Direction:=0 wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7 Else wdDoc.Range(wdDoc.Characters.Count - 1).InsertBreak Type:=7 End If Next ws wdDoc.Styles("No Spacing").NoSpaceBetweenParagraphsOfSameStyle = True wdDoc.Save Set wdDoc = Nothing Set wdApp = Nothing Set fromWB = Nothing MsgBox "Imported into Word Document" ResetSettings: Application.ScreenUpdating = True Application.DisplayAlerts = True Application.EnableEvents = True End Sub