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

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

我现在正在使用Excel.RANGE.copy. 复制两个表格并粘贴在文件上。

但是，这两个范围变成了两个单独的表格，原来的Excel表格格式不能inheritance到新的单词文件。另外，来自单词报告的一些单元格将显示在两行中。

总之，这个单词报告的格式将非常混乱。 如何将两个表格整合到一个具有良好表格格式或alignment的表格中？

新的表格将会像这样产生：（red pen = problems）

我的代码：

  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 

新的后遗症

Answer 1

尝试以下。 简单地将行之间隐藏（你不想看到的），并作为一个范围从“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 eg 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