Question

我正在开发一个宏，该宏可将一系列单元格从excel转移到单词书签。我遇到的问题是没有转移我选择的整个范围。不确定范围的最大范围是否有限制？还希望传输的内容自动适应Word文档的页边距吗？

到目前为止，我的代码是：

'Name of the existing Word doc.
Const stWordReport As String = "Exporting a Table to a Word Document 2.docx"    

'Word objects.
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim wdbmRange As Word.Range

'Excel objects.
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnReport As Range
'Dim Table1 As Range

Dim coluna As Integer
coluna = Worksheets("Planilha1").Cells(1, Worksheets("Planilha1").Columns.Count).End(xlToLeft).Column
Table1 = Worksheets("Planilha1").Range(Cells(4, 4), Cells(16, coluna))

'Initialize the Excel objects.
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Planilha1")
Set rnReport = wsSheet.Range("Table1")

'Initialize the Word objects.
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)
Set wdbmRange = wdDoc.Bookmarks("Report").Range

'Turn off screen updating.
Application.ScreenUpdating = False

'Copy the report to the clipboard.
rnReport.Copy

'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
With wdbmRange
    .Select
    .PasteSpecial Link:=False, _
                  DataType:=wdPasteMetafilePicture, _
                  Placement:=wdInLine, _
                  DisplayAsIcon:=False
End With

'Save and close the Word doc.
With wdDoc
    .Save
    .Close
End With

'Quit Word.
wdApp.Quit

'Null out your variables.
Set wdbmRange = Nothing
Set wdDoc = Nothing
Set wdApp = Nothing

'Clear out the clipboard, and turn screen updating back on.
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With

MsgBox "The report has successfully been " & vbNewLine & _
       "transferred to " & stWordReport, vbInformation

我希望word文档中的内容具有与excel相同的格式并适合页面。

Answer 1

Word的最大列数为63；没有设定的行数限制。无论如何，由于您将复制的内容粘贴为图片，因此表格限制并不重要。我怀疑真正的问题在于您如何确定可乐。试试：

'Initialize the Excel objects.
Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Planilha1")
Set rnReport = wsSheet.Range("Table1")

coluna = wsSheet.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Column
Table1 = wsSheet.Range(Cells(4, 4), Cells(16, coluna))

从excel VBA复制到word时范围有限

1 个答案: