Question

我有一些代码应该用excel中的数据复制一系列单元格，然后将其粘贴到word文档中。代码运行良好，但问题是当它将数据粘贴到单词中时，表格后会出现几个空白页面。代码在这里。有没有人知道如何修复它，以便只复制有数据的部分，我可以摆脱空白页？

Sub ExportToWord()
'Option Explicit

Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
Dim SrcePath As String
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range


    'Copies the specified range in excel
Set sht = Worksheets("Calculations")
Set StartCell = Range("M3")

'Refresh UsedRange
  Worksheets("Calculations").UsedRange

'Find Last Row
  LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'Select Range
  sht.Range("M3:R" & LastRow).Copy


    'Create an Instance of MS Word
  On Error Resume Next

    'Is MS Word already opened?
  If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")

    'Clear the error between errors
      Err.Clear

    'If MS Word is not already open then open MS Word
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")

    'Handle if the Word Application is not found
      If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0

    'Make MS Word Visible and Active
    WordApp.Visible = True
    WordApp.Activate

    'Create a New Document
    Set myDoc = WordApp.Documents.Add

    'Paste Table into MS Word
    myDoc.Paragraphs(1).Range.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False

    'Autofit Table so it fits inside Word Document
    Set WordTable = myDoc.Tables(1)
    WordTable.AutoFitBehavior (wdAutoFitWindow)

    'Insert Header logo
    SrcePath = ""

    myDoc.Sections.Item(1).Headers(wdHeaderFooterPrimary) _
        .Range.InlineShapes.AddPicture (SrcePath)

    'Prompts users to save document
    WordApp.Documents.Save NoPrompt:=False

EndRoutine:
    'Optimize Code
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    'Clear The Clipboard
    Application.CutCopyMode = False

    'Closes the Word application and the document
    On Error GoTo Err1:
    myDoc.Close
    WordApp.Quit
    Set WordApp = Nothing

Err1:

End Sub

Answer 1

有一种手动方法。

选择表格，单击鼠标右键，然后转到“设置单元格格式”。然后选择“数字”-“数字”-“确定”，就像我附带的图片一样。

example

我希望这会有所帮助。

从Excel复制到Word。 Word创建了很多空白页面

1 个答案: