尝试创建 VBA 以将 Excel 表格粘贴到 Word 中

Question

我创建了一个宏来将 Excel 表格粘贴到 Word 中，但该宏不起作用，而且我不知道我做错了什么。 请参阅下面的代码以供参考。

我还检查了“参考”->“Microsoft Word 16.0 对象库”

蒂亚！

'
' CreateLabels Macro

Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("C:\Users\username\Desktop\New Template.doc")
Dim x As Workbook
 
'Open Excel and Copy labels
    Set x = Workbooks.Open("Excel file path")
 
    With x.Sheets("Receiving Labels")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With
    x.Sheets("Receiving Labels").Range("A1:E" & LastRow).Copy

With objDoc.Paragraphs(objDoc.Paragraphs.Count).Range
   'All formatting goes here
   .Paste
   .Font.Name = "Calibri"
   .Font.Color = wdColorBlack
   .Font.Bold = False
   .Font.Italic = False
   .Font.Allcaps = False
   .Font.Size = 8
End With
objWord.Visible = True
 
End Sub

Answer 1

试试这个：

Sub ExcelToWord()

'PURPOSE: Copy/Paste An Excel Table Into a New Word Document
'NOTE: Must have Word Object Library Active in Order to Run _
  (VBE > Tools > References > Microsoft Word 12.0 Object Library)
'SOURCE: www.TheSpreadsheetGuru.com

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False

'Copy Range from Excel
  Set tbl = ThisWorkbook.Worksheets(Sheet1.Name).ListObjects("Table1").Range

'Create an Instance of MS Word
  On Error Resume Next
    
    'Is MS Word already opened?
      Set WordApp = GetObject(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
  
'Copy Excel Table Range
  tbl.Copy

'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)
  
EndRoutine:
'Optimize Code
  Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
  Application.CutCopyMode = False

End Sub