将 Excel 打印区域复制到 Word

Question

我想将 Excel 中横向的打印区域复制到我的 Word 文档中，并从中运行代码。

我正在使用

wb.Sheets("Sheet1").Range("A1:N33").Copy

复制区域，但是随着列宽的变化，就没用了。

更新：

我正在使用它来计算我在 Word 文档中的可用尺寸

With ActiveDocument.PageSetup
      UsableWidth = .PageWidth - .LeftMargin - .RightMargin
      UsableHeight = .PageHeight - .TopMargin - .BottomMargin
End With

我试图缩放我的图像以适应：

Selection.PasteSpecial Link:=False, DataType:=wdPasteMetafilePicture, Placement:=wdInLine, DisplayAsIcon:=False
Selection.ShapeRange.Height = UsableHeight
Selection.ShapeRange.Width = UsableHeight

它并没有完全做到这一点。最好的方法是在复制之前设置图像范围。

更新2：

Dim objExcel As New Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Set wb = objExcel.Workbooks.Open("C:\test.xlsx")
Set ws = wb.Sheets("Sheet1")

这给出了一个错误：

Set rngTemp = ws.Range("A1")

Answer 1

您可以使用此代码检索打印区域信息：

Sub GetPrintArea()

Dim rngPrintArea As Range

'Put print area into range variable
Set rngPrintArea = Sheet1.Range(Sheet1.PageSetup.PrintArea)

'Perform operations on range - shows up in Immediate window:
Debug.Print rngPrintArea.Height
Debug.Print rngPrintArea.Width
Debug.Print rngPrintArea.Cells(rngPrintArea.Rows.Count, rngPrintArea.Columns.Count).Address

End Sub

如果尚未设置打印区域，这将不起作用 - 您能否确认 Excel 工作表是否已设置为横向并定义了打印区域？如果没有，您将需要找到纸张尺寸并遍历单元格，直到找到共享相同 Left 和 Top 值的那些（我认为）。您可以像这样设置 PrintArea：

'Set print area
Sheet1.PageSetup.PrintArea = "$A1:$N33"

---

编辑 - 现在我们知道源尺寸是预定义的 - 您需要在 Word 中设置 UseableWidth 和 UseableHeight 并使用 ByVal 或公共变量将它们带入此子项：

Sub FindRange()

Dim rngTemp As Range, rngCopy As Range, rngTest As Range
Dim iCol As Integer, iRow As Integer

Set rngTemp = Sheet1.Range("A1")

'Get closest column
Do Until rngTemp.Left >= UseableWidth
        Set rngTemp = rngTemp.Offset(0, 1)
Loop
iCol = rngTemp.Column

'Get closest row
Do Until rngTemp.Top >= UseableHeight
        Set rngTemp = rngTemp.Offset(1, 0)
Loop
iRow = rngTemp.Row

Set rngCopy = Sheet1.Range("A1", Sheet1.Cells(iRow, iCol))

'Copy rngCopy into Word as you were before

End Sub