| |
▼satoko さん：
おはようございます。
追加1.にてレスの内容を入れてみました。
確認してみて下さい。
受け付け番号が入っていくところが違う様なら
Const IntNoRow As Long = 2 ← 2を適切な値に変更して下さい。
解らない事があれば聞いて下さい。解る範囲でお答えします。
Private Sub Btn_Cancel_Click()
Me.Hide
End Sub
Private Sub Btn_Ret_Click()
'帳票の先頭列番号
Const IntColStart As Long = 1
'帳票の末尾列番号
Const IntColLast As Long = 8
'帳票1番号分の行数
Const Cnt As Long = 5
'1ページ当りの受け付け番号数
Const CntNo As Long = 6
'受け付け番号書き出し列番号
Const IntNoCol As Long = 1
'受け付け番号書き出し行位置（帳票1番号分内での）
Const IntNoRow As Long = 2
Dim IntStartId As Long, IntStartRow As Long
Dim IntLastId As Long, IntLastRow As Long
Dim i As Long, j As Long
'テキストボックスの入力エラー確認
'===================================================================================
If Me.Txt_StartId = "" Then 'Txt_StartIdが空白の場合
MsgBox "開始位置を入力してから実行して下さい。", vbExclamation, "開始位置未記入"
Me.Txt_StartId.SetFocus
Exit Sub
End If
IntStartId = Str_Chk(Me.Txt_StartId) '
If IntStartId = 0 Then 'Txt_StartIdが数値に変換出来ない値だった場合
MsgBox "開始位置の入力形式に誤りがあります。", vbExclamation, "開始位置ｴﾗｰ"
Me.Txt_StartId.SetFocus
Exit Sub
End If
If Me.Txt_LastId = "" Then 'Txt_LastIdが空白の場合
MsgBox "終了位置を入力してから実行して下さい。", vbExclamation, "終了位置未記入"
Me.Txt_LastId.SetFocus
Exit Sub
End If
IntLastId = Str_Chk(Me.Txt_LastId)
If Str_Chk(Me.Txt_LastId) = 0 Then 'Txt_LastIdが数値に変換出来ない値だった場合
MsgBox "終了位置の入力形式に誤りがあります。", vbExclamation, "終了位置ｴﾗｰ"
Me.Txt_LastId.SetFocus
Exit Sub
End If
'追加1.ここから <------
If IntStartId = IntLastId Then 'Txt_StartId = Txt_LastIdの場合
MsgBox "終了位置が開始位置と等しい為実行出来ません。", vbExclamation, "終了位置ｴﾗｰ"
Me.Txt_LastId.SetFocus
Exit Sub
Elseif IntStartId < IntLastId Then 'Txt_StartId < Txt_LastIdの場合
MsgBox "終了位置が開始位置より手前な為実行出来ません。", vbExclamation, "終了位置ｴﾗｰ"
Me.Txt_LastId.SetFocus
Exit Sub
End If
' ------> ここまで追加1.
' 開始行,終了行の設定
'===================================================================================
IntStartRow = (IntStartId - 1) * Cnt + 1
IntLastRow = (IntLastId) * Cnt
ViewSet = ActiveWindow.View
ActiveWindow.View = xlNormalView
With ThisWorkbook.Sheets("印刷")
'追加1.ここから <------
' 受付番号の書き出し
'===================================================================================
For j = IntStartId To IntLastId
.Cells((j - 1) * Cnt + IntNoRow , IntNoCol) = j
Next
' ------> ここまで追加1.
' 一旦印刷範囲の設定を初期化
'===================================================================================
.PageSetup.PrintArea = ""
' 一旦改ページを初期化
'===================================================================================
.Cells.PageBreak = xlPageBreakNone
' 印刷範囲の設定
'===================================================================================
.PageSetup.PrintArea = .Cells(IntStartRow, IntColStart).Address & ":" & .Cells(IntLastRow, IntColLast).Address
' 改ページの設定 (6項目毎でページを別ける)
'===================================================================================
.Columns(IntColLast + 1).PageBreak = xlPageBreakManual
i = 1
Do
.Cells(i * Cnt * CntNo + IntStartRow , IntColStart).PageBreak = xlPageBreakManual
i = i + 1
Loop Until i * Cnt * CntNo + IntStartRow > IntLastRow
.PrintOut
End With
ActiveWindow.View = ViewSet
End Sub
Function Str_Chk(StrTmp)
On Error Resume Next
Buf = CLng(StrTmp)
If Err Then
Buf = 0
Err.Clear
End If
Str_Chk = Buf
End Function
|
|
kazu
- 05/2/24(木) 9:37 -
