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

它不是那么做的。最好的方法是在复制之前设置图像范围。

UPDATE2：

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

将Excel打印区域复制到Word

1 个答案: