| |
以前こちらの掲示板で教えていただいたのですが、印刷する様式が変更になりコードをいじったのですが改ページがうまくいきません。ユーザーフォームでプリントアウトしたい開始番号・終了番号を入力したらその番号分だけ印刷するようにしたいのですが、１ページに１０件ずつ印刷できるはずが、９件までしか印刷されません。しかも、２ページ目は１１件から印刷されます。どのように直せばいいか教えてください(＞＿＜)
印刷する様式は下図のような表で、番号が入力されれば他の欄はvLookup関数で入るようになっています。印刷する様式はＡ１：ＣＩ２２まで使用しています。その下にコードを入れましたので、どこをどう直せばいいのか教えてください！お願いします(＞＿＜)
ＡＢＣＤＥＦＧＨＩＪＫＬ・・・・・・・・CI
｜＿＿＿＿＿＿＿＿＿＿＿＿
１｜ ｜ ｜ ｜
２｜番号｜・・・｜・・｜・・
＿＿＿＿＿＿＿＿＿＿＿＿
３｜ ｜ ｜ ｜
４｜ １ ｜ ｜ ｜
＿＿＿＿＿＿＿＿＿＿＿＿
５｜ ｜ ｜ ｜
６｜ ２ ｜ ｜ ｜
↓ ↓
＿＿＿＿＿＿＿＿＿＿＿＿
２１｜ ｜ ｜ ｜
２２｜１０｜ ｜ ｜
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''CommandButtonのキャンセルをクリックしたとき '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Btn_Cancel_Click()
'ユーザーフォームの「印刷」を閉じる
Me.Hide
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'CommandButtonのＯＫをクリックしたとき '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Btn_Ret_Click()
Worksheets("印刷").Visible = True
'Worksheet印刷(文書収受件名簿様式)の先頭列番号(Ａ列)
Const IntColStart As Long = 1
'Worksheet印刷(文書収受件名簿様式)の末尾列番号(ＣＩ列)
Const IntColLast As Long = 87
'Worksheet印刷(文書収受件名簿様式)の１つのデータが使用する行数
Const Cnt As Long = 2
'Worksheet印刷(文書収受件名簿様式)１ページあたりの受付番号数
Const CntNo As Long = 10
'Worksheet印刷 (文書収受件名簿様式)の開始行
Const Int_Fst As Long = 1
'Worksheet印刷(文書収受件名簿様式)の受付番号の書き出し列番号
Const IntNoCol As Long = 1
''Worksheet印刷(文書収受件名簿様式)の受付番号の書き出し行番号(データ１番号分内での)
Const IntNoRow As Long = 3
Dim IntStartId As Long, IntStartRow As Long
Dim IntLastId As Long, IntLastRow As Long
Dim i, J As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'テキストボックスの入力エラー確認 '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Txt_StartId(開始番号)が未記入の場合、メッセージボックス「開始位置を入力してから実行してください」が現れる
If Me.Txt_StartId = "" Then
MsgBox "開始位置を入力してから実行して下さい。", vbExclamation, "開始位置未記入"
Me.Txt_StartId.SetFocus
Exit Sub
End If
'Txt_StartId(開始番号)がOの場合、メッセージボックス「開始位置の入力形式に誤りがあります」が現れる
IntStartId = Str_Chk(Me.Txt_StartId)
If IntStartId = 0 Then
MsgBox "開始位置の入力形式に誤りがあります。", vbExclamation, "開始位置ｴﾗｰ"
Me.Txt_StartId.SetFocus
Exit Sub
End If
'Txt_Txt_LastId(終了番号)が未記入の場合、メッセージボックス「終了位置を入力してから実行してください」が現れる
If Me.Txt_Txt_LastId = "" Then
MsgBox "終了位置を入力してから実行して下さい。", vbExclamation, "終了位置未記入"
Me.Txt_Txt_LastId.SetFocus
Exit Sub
End If
'Txt_Txt_LastId(終了番号)が0の場合、メッセージボックス「終了位置の入力形式に誤りがあります」が現れる
IntLastId = Str_Chk(Me.Txt_Txt_LastId)
If Str_Chk(Me.Txt_Txt_LastId) = 0 Then
MsgBox "終了位置の入力形式に誤りがあります。", vbExclamation, "終了位置ｴﾗｰ"
Me.Txt_Txt_LastId.SetFocus
Exit Sub
End If
'Txt_StartId(開始番号)とTxt_Txt_LastId(終了番号)の数字が等しいとき、メッセージボックス「終了位置が開始位置と等しいため実行できません。」が現れる
If IntStartId = IntLastId Then
MsgBox "終了位置が開始位置と等しいため実行できません。", vbExclamation, "終了位置ｴﾗｰ"
Me.Txt_Txt_LastId.SetFocus
Exit Sub
End If
'Txt_StartId(開始番号)の数字がTxt_Txt_LastId(終了番号)より大きいとき、メッセージボックス「終了位置が開始位置より手前なため実行できません。」が現れる
If IntStartId > IntLastId Then
MsgBox "終了位置が開始位置より手前なため実行できません", vbExclamation, "終了位置ｴﾗｰ"
Me.Txt_Txt_LastId.SetFocus
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 開始行,終了行の設定 '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Me.Hide
ViewSet = ActiveWindow.View
ActiveWindow.View = xlNormalView
With ThisWorkbook.Sheets("印刷")
' 一旦印刷範囲の設定を初期化
'===================================================================================
.PageSetup.PrintArea = ""
' 一旦改ページを初期化
'===================================================================================
.Cells.PageBreak = xlPageBreakNone
' 改ページの設定 (6項目毎でページを別ける)
'===================================================================================
.Columns(IntColLast + 1).PageBreak = xlPageBreakManual
.Cells(Cnt * CntNo + 3, IntColStart).PageBreak = xlPageBreakManual
' 印刷範囲の設定
'===================================================================================
.PageSetup.PrintArea = .Cells(Int_Fst, IntColStart).Address & _
":" & .Cells(Cnt * CntNo, IntColLast).Address
'受付番号の書き出し + 印刷
'===================================================================================
J = 1
For i = IntStartId To IntLastId Step 1
.Cells((J - 1) * Cnt + IntNoRow, IntNoCol) = i
J = J + 1
If J = 11 Then
.PrintOut
For J = 1 To 10
.Cells((J - 1) * Cnt + IntNoRow, IntNoCol).Value = ""
Next
J = 1
End If
Next
If J <> 1 Then
.PrintOut
End If
End With
Worksheets("印刷").Visible = False
End Sub
Function Str_Chk(StrTmp)
On Error Resume Next
Buf = CInt(StrTmp)
If Err Then
Buf = 0
Err.Clear
End If
Str_Chk = Buf
End Function
Private Sub UserForm_Click()
End Sub
|
|
ｓａｔｏｋｏ
- 05/12/9(金) 11:25 -
