0

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")
4

1 に答える 1

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シートが印刷領域が定義された横向きにすでに設定されているかどうかを確認できますか？そうでない場合は、用紙の寸法を見つけて、同じ左と上の値を共有するセルが見つかるまでセルをループする必要があります（私は思います）。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
于 2013-01-22T10:24:16.153 に答える