| |
ま、いいです。むこうのスレは長くなりすぎてますから、こちらで続けます。
>別シートにコピーしたくなかった
のであれば、アクティブシートの使用していない範囲(仮にAA列以降とする)に
コピーするのでも構いません。その場合、コードは以下のようにします。
A:F列が表の範囲という前提です。列は固定しても大丈夫なはずだから、このように
配列も固定します。行は不定ですから、動的配列で行高を取得しています。
Sub MyData_Copy_Print()
Dim MyR As Range, C As Range
Dim Cw(1 To 6) As Single, Rh() As Single
Dim i As Long, j As Long, Ans As Long
If Hck = False Then Exit Sub
Set MyR = Range("B1", Range("B65536").End(xlUp)) _
.Offset(, -1).Resize(, 6).SpecialCells(12)
For i = 1 To 6
Cw(i) = Columns(i).ColumnWidth
Next i
For Each C In MyR.Rows
j = j + 1
ReDim Preserve Rh(j): Rh(j) = C.RowHeight
Next
MyR.Copy
Cells.EntireRow.Hidden = False
Range("AA1").PasteSpecial
Application.CutCopyMode = False
With Range("AA1").CurrentRegion
For i = 1 To 5
.Columns(i).ColumnWidth = Cw(i)
Next i
For j = 1 To .Rows.Count
.Rows(j).RowHeight = Rh(j)
Next j
ActiveSheet.PageSetup.PrintArea = .Address
End With
Erase Cw, Rh: Set MyR = Nothing: Hck = False
Ans = MsgBox("このシートを印刷しますか", 36)
On Error Resume Next
If Ans = 6 Then ActiveSheet.PrintPreview 'ActiveSheet.PrintOut
ActiveSheet.PageSetup.PrintArea = ""
Range("AA:AF").ClearContents
End Sub
MsgBox が出たら「はい」を押してプレビューで確認して下さい。
本番で印刷するなら PrintPreview を消して PrintOut にするだけです。
|
|
Kein
- 04/9/21(火) 20:23 -
