| |
▼shin さん、皆さん、こんばんは。
>チャッピーさんありがとうございます。
>お答えしていただいたことがよくわかっていません。
>
>もうすこし具体的にご指導よろしくお願いします。
飛び飛びのページ設定・・・、そんな場合もあるかもしれませんねえ。
即興で作ったので間違いがあるかもしれませんし、他に方法があるかもしれませんが、
確認して下さい。
アクティブシートに対するページ設定です。
'================================================================
Sub main()
Call pr_settei(Range("$A3:$s$27,$A$28:$s$52,$A$53:$s$77,$A$78:$s$102,$A$103:$s$127,$A$128:$s$152"))
ActiveSheet.PrintPreview
End Sub
'====================================================================
Sub pr_settei(prng As Range)
Dim ar As Range
ActiveSheet.Cells.PageBreak = xlPageBreakNone '手動設定の解除
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.PageSetup. _
PrintTitleRows = "$1:$2"
' 本当は、↑の辺もパラーメータ渡しの方がいいです。
ActiveSheet.PageSetup.Zoom = 100
ActiveSheet.PageSetup.PrintArea = ""
For Each ar In prng.Areas
ActiveSheet.PageSetup.PrintArea = ar.Address
Call VDRGOFF(ActiveSheet, ar) 'オートマチックの解除
Call HDRGOFF(ActiveSheet, ar)
ActiveSheet.HPageBreaks.Add Range(Cells(ar.Row + ar.Rows.Count, 1), Cells(ar.Row + ar.Rows.Count, ar.Columns.Count))
Next
ActiveWindow.View = xlNormalView
ActiveSheet.PageSetup.PrintArea = prng.Address
End Sub
'================================================================
Sub VDRGOFF(sht As Worksheet, rng As Range)
On Error Resume Next
Dim vv As VPageBreak
For Each vv In sht.VPageBreaks
If Not Application.Intersect(vv.Location, rng) Then
vv.DragOff xlToRight, 1
End If
Next
On Error GoTo 0
End Sub
'================================================================
Sub HDRGOFF(sht As Worksheet, rng As Range)
On Error Resume Next
Dim hh As HPageBreak
For Each hh In sht.HPageBreaks
If Not Application.Intersect(hh.Location, rng) Then
hh.DragOff xlDown, 1
End If
Next
On Error GoTo 0
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
