插入上表标题和““远程服务器计算机不存在”。-重新运行宏工作正常之后

Question

如何为https://www.thespreadsheetguru.com/blog/2014/5/22/copy-paste-an-excel-table-into-microsoft-word-with-vba中的代码插入表格标题。此代码将表格从Excel复制到Word，我想在表格上方添加标题。

**

Sub ExcelRangeToWord()

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table
  Application.ScreenUpdating = False
  Application.EnableEvents = False

  Set tbl = ThisWorkbook.Worksheets("xd").ListObjects("Table1").Range
  On Error Resume Next
          Set WordApp = GetObject(class:="Word.Application")
          Err.Clear
      If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application")
          If Err.Number = 429 Then
        MsgBox "Microsoft Word could not be found, aborting."
        GoTo EndRoutine
      End If

  On Error GoTo 0
   WordApp.Visible = True
  WordApp.Activate
     Set myDoc = WordApp.Documents.Open("C:\ test.docx")
  tbl.Copy

  myDoc.Paragraphs(1).Range.PasteExcelTable _
    LinkedToExcel:=False, _
    WordFormatting:=False, _
    RTF:=False
  Set WordTable = myDoc.Tables(1)
  WordTable.Rows.SetHeight RowHeight:=InchesToPoints(0.17), HeightRule:=wdRowHeightExactly  
ActiveDocument.Tables(1).Range.InsertCaption _
label:=wdCaptionTable, _
Title:=": test", _
Position:=wdCaptionPositionAbove


EndRoutine:
  Application.ScreenUpdating = True
  Application.EnableEvents = True

  Application.CutCopyMode = False

End Sub

**

Answer 1

这对我来说很好：

Sub ExcelRangeToWord()

    Dim WordApp As Word.Application
    Dim myDoc As Word.Document
    Dim WordTable As Word.Table

    Set WordApp = GetWord("Could not start Word - will now exit")
    If WordApp Is Nothing Then Exit Sub

    Set myDoc = WordApp.Documents.Add()
    ThisWorkbook.Worksheets("xd").ListObjects("Table1").Range.Copy

    myDoc.Paragraphs(1).Range.PasteExcelTable LinkedToExcel:=False, _
                                    WordFormatting:=False, RTF:=False
    Set WordTable = myDoc.Tables(1)
    WordTable.Rows.SetHeight RowHeight:=WordApp.InchesToPoints(0.17), HeightRule:=wdRowHeightExactly
    myDoc.Tables(1).Range.InsertCaption Label:=wdCaptionTable, _
                      Title:=": test", Position:=wdCaptionPositionAbove

End Sub

'factored out to reusable function...
Function GetWord(Optional errMsg As String = "") As Word.Application
    Dim rv As Word.Application
    On Error Resume Next
    Set rv = GetObject(, "Word.Application")
    If rv Is Nothing Then Set rv = CreateObject("Word.Application")
    If Not rv Is Nothing Then
        rv.Visible = True
    Else
        If Len(errMsg) > 0 Then MsgBox errMsg, vbExclamation, "Problem starting Word"
    End If
    Set GetWord = rv
End Function