Vba 如何将excel范围集成到一个表中？

我在excel文件中有两个范围。 （A79-I84）和（A90-I92）

我现在使用

Excel.RANGE.copy.

复制两个表并粘贴到word文件上

但是，这两个区域成为两个单独的表格，原始excel表格格式无法继承到新的word文件中。此外，word报告中的某些单元格将显示为两行

总之，word报告的格式将非常混乱。 如何以良好的表格格式或对齐方式将两个表格集成到一个表格中

新表将按如下方式生成： （红笔=问题）

我的代码：

 Sub ExcelRangeToWord()


Dim tbl0 As Excel.RANGE
Dim tbl As Excel.RANGE
Dim tbl2 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 tbl0 = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A78:I83")
  Set tbl = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A78:I83")
  Set tbl2 = ThisWorkbook.Worksheets(sheet9.Name).RANGE("A90:I92")

'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



'Trigger copy separately for each table + paste for each table

    tbl.Copy ' paste range1
    myDoc.Paragraphs(1).RANGE.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=True, _
        RTF:=False

'before that...
'...go to end of doc and add new paragraph
    myDoc.Bookmarks("\EndOfDoc").RANGE.InsertParagraphAfter
    tbl2.Copy 'paste range2

'Paste Table into MS Word last paragraph
    myDoc.Paragraphs(myDoc.Paragraphs.Count).RANGE.PasteExcelTable _
        LinkedToExcel:=False, _
        WordFormatting:=True, _
        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

新后遗症

---

尝试以下方法。只需隐藏中间的行（您不想看到的行），并将其复制为一个范围，从“A79:I92”开始，然后粘贴为图片。用于调整图像大小的子对象的贷方（）。注意，这将调整所有图像的大小，但可以调整为仅针对一个图像

Option Explicit

Sub ExcelRangeToWord()


    Dim tbl0 As Excel.Range
    Dim Tbl As Excel.Range
    Dim tbl2 As Excel.Range

    Dim wordApp As Word.Application
    Dim myDoc As Word.Document
    Dim WordTable As Word.Table
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet2")             ' Change e.g. sheet9.Name
    'Optimize Code
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ws.Rows("84:89").EntireRow.Hidden = True 'ADJUST AS APPROPRIATE

    'Copy Range from Excel
    'Set tbl0 = ws.RANGE("A78:I83")
    Set Tbl = ws.Range("A78:I92")


    ' Set tbl2 = ws.Range("A90:I92")

    '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

    'Trigger copy separately for each table + paste for each table

    Tbl.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    wordApp.Selection.Paste
    wordApp.Selection.TypeParagraph

    wordApp.Selection.PageSetup.Orientation = wdOrientLandscape

    resize_all_images_to_page_width myDoc

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

    'Clear The Clipboard
    Application.CutCopyMode = False

End Sub


Sub resize_all_images_to_page_width(myDoc As Document)
  'https://blog.qiqitori.com/?p=115
    Dim inline_shape As InlineShape
    Dim percent As Double

    For Each inline_shape In myDoc.InlineShapes
        inline_shape.LockAspectRatio = msoFalse
        inline_shape.ScaleWidth = 100
        inline_shape.ScaleHeight = 100
        percent = myDoc.PageSetup.TextColumns.Width / inline_shape.Width
        inline_shape.ScaleWidth = percent * 100
        inline_shape.ScaleHeight = percent * 100
    Next
End Sub

---

是否无法隐藏中间的行，在现在相邻的范围周围设置打印区域，并以某种方式将其导出为图像或对象？是否可以使用vba将这两个范围导出为一个大表和一个图像？是否需要在Word中编辑对象？@QHarr无需。这是供以后打印或邮寄的报告。我发布的答案仍然无法从原始excel继承对齐方式（中心对齐）。此外，原始excel中的某些单元格在新word报告中被分成两行。如何改进新表格格式？您已应用以下WordTable.AutoFitBehavior（wdAutoFitWindow）因此原始对齐方式将更改。您可以添加Excel中的外观图像吗？添加。顺便说一句，我发现您的代码无法成功加入第二个表（Excel范围2）兄弟，还有一个问题。粘贴为表格格式会更困难吗？出于某种原因，它对未来的表格修改更灵活。如果不是，对象（图片）可能最适合word文档？（这样，我就不必每次都修改图片大小。）最后，在粘贴图片之前，是否可以在Word中将页面预先设置为横向？