Excelで印刷したら、文字切れしてた〜〜〜
結合部分がページまたがる〜〜
そんな悩みを解消できます。
列幅は未対応。
対応したファイルもダウンロードできます。
http://www.pcs-assist.com/bbs.html
Sub 行高調整()
Application.ScreenUpdating = False '画面のちらつきを抑える
Cells.EntireRow.AutoFit ' シート全体の行を自動調整させる
Dim myRow As Long '行の高さは、日々変わるので変数に代入
For myRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row '1行目から最終行まで繰り返す
With Cells(myRow, 2)
' 高さを15足す
.RowHeight = .RowHeight + 25
End With
Next myRow
Application.ScreenUpdating = True 'ちらつきの設定を戻しておく
End Sub
Sub Heightreset()
Rows.RowHeight = 13.5
End Sub
Sub 行結合対応改ページ()
' 水平方向の改ページ位置を結合セル内から外し、上に調整移動する
'----------------------
Const TargetCol = "A" ' <--- 改ページに反映させる結合のある列を指定
'----------------------
Dim Rng As Range
Dim HPB As Long
Dim Rw As Long
Application.ScreenUpdating = False
Cells.EntireRow.AutoFit ' シート全体の行を自動調整させる
Dim myRow As Long
For myRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
With Cells(myRow, 2)
' 高さを15足す
.RowHeight = .RowHeight + 25
End With
Next myRow
Application.ScreenUpdating = True ' False禁止
'何らかの編集が行われている範囲の右下端セルを選択し、Rng変数にそのセル番地を代入。
Set Rng = Range("a2").SpecialCells(xlCellTypeLastCell).Offset(1, 0)
With ActiveSheet
If .HPageBreaks.Count = 0 Then Exit Sub 'アクティブシートの改ページが0だったら終了
'ResetAllPageBreaksメソッドを使用すると設定した改ページを全て解除する事が出来ます。
ActiveSheet.ResetAllPageBreaks
For HPB = 1 To .HPageBreaks.Count ' 改ページの数だけ回す
'HPageBreaks インデックスによって参照されている水平方向の改ページより上にアクティブ セルがある場合、エラーになるので!
'最終セルをアクティブにする必要がある。
Rng.Activate
'1つ目の改ページ行数をRw変数に代入。18行目と19行目が結合されていれば、19がRwに代入される。
Rw = .HPageBreaks(HPB).Location.Row
'セル番地(最初の改ページ行番号,列番号は1)
'Range("A1").Columnで列番号を取得。結合されているセル番地がアクティブになる。
Cells(Rw, Range(TargetCol & 1).Column).Activate
'18行目と19行目が結合されていれば、selection行は18、Rwは19、Rwの方が大きいので、改ページが変更される
If Selection.Row < Rw Then
.HPageBreaks.Add Before:=ActiveCell '前に水平改ページする
End If
Next HPB '改ページの数だけ繰り返す。
End With
Range("A1").Activate
Set Rng = Nothing
End Sub
Sub 行結合対応改ページと行調整()
'----------------------
Const TargetCol = "A" ' <--- 改ページに反映させる結合のある列を指定
'----------------------
Dim Rng As Range
Dim HPB As Long
Dim Rw As Long
Application.ScreenUpdating = False
Cells.EntireRow.AutoFit ' シート全体の行を自動調整させる
Dim myRow As Long
For myRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
With Cells(myRow, 2)
' 高さを15足す
.RowHeight = .RowHeight + 25
End With
Next myRow
Application.ScreenUpdating = True ' False禁止
'何らかの編集が行われている範囲の右下端セルを選択し、Rng変数にそのセル番地を代入。
Set Rng = Range("a2").SpecialCells(xlCellTypeLastCell).Offset(1, 0)
With ActiveSheet
If .HPageBreaks.Count = 0 Then Exit Sub 'アクティブシートの改ページが0だったら終了
'ResetAllPageBreaksメソッドを使用すると設定した改ページを全て解除する事が出来ます。
ActiveSheet.ResetAllPageBreaks
For HPB = 1 To .HPageBreaks.Count ' 改ページの数だけ回す
'HPageBreaks インデックスによって参照されている水平方向の改ページより上にアクティブ セルがある場合、エラーになるので!
'最終セルをアクティブにする必要がある。
Rng.Activate
'1つ目の改ページ行数をRw変数に代入。18行目と19行目が結合されていれば、19がRwに代入される。
Rw = .HPageBreaks(HPB).Location.Row
'セル番地(最初の改ページ行番号,列番号は1)
'Range("A1").Columnで列番号を取得。結合されているセル番地がアクティブになる。
Cells(Rw, Range(TargetCol & 1).Column).Activate
'18行目と19行目が結合されていれば、selection行は18、Rwは19、Rwの方が大きいので、改ページが変更される
If Selection.Row < Rw Then
.HPageBreaks.Add Before:=ActiveCell '前に水平改ページする
End If
Next HPB '改ページの数だけ繰り返す。
End With
Range("A1").Activate
Set Rng = Nothing
End Sub