Here is the code as it stands. First I update the recordset with the cheque no. The report prints cheques including the cheque no. If the highlighted code is omitted the cheque no. doesn't print on the first pass but if you select to reprint it does. (If anybody is interested but the code is long winded I will try to abridge.)
Option Compare Database
Option Explicit
' store cheque nos in transactions
Private Sub UpdateTrans(intPass As Integer)
Dim rstTran As Recordset
Dim lngChequeNo As Long
On Error GoTo Err_Routine
' get cheque fee transactions
ConnectProject
Set rstTran = New Recordset
strSQL = "SELECT * " _
& "FROM tblTransaction " _
& "WHERE blnTrnChequeRequired = True "
rstTran.Open strSQL, cnnProject, adOpenKeyset, adLockPessimistic, adCmdText
On Error Resume Next
rstTran.MoveFirst
On Error GoTo Err_Routine
' initial
lngChequeNo = CLng(Me.txtFirstChequeNo)
' each transaction
Do While Not rstTran.EOF
If intPass = 1 Then
rstTran!strTrnOurCheque = Format(lngChequeNo, "000000")
Else
rstTran!blnTrnChequeRequired = False
rstTran!blnTrnChequePrinted = True
rstTran!dtmTrnChequeDate = Date
rstTran!strTrnSystemUser = CurrentUser()
rstTran!dtmTrnSystemDate = Now()
End If
rstTran.Update
' next
rstTran.MoveNext
If lngChequeNo = 999999 Then
lngChequeNo = 1
Else
lngChequeNo = lngChequeNo + 1
End If
Loop
Exit_Routine:
On Error Resume Next
' close recordset
rstTran.Close
Set rstTran = Nothing
DisconnectProject
Exit Sub
Err_Routine:
MsgBox Err.Description
Resume Exit_Routine
End Sub
' cancel
Private Sub cmdCancel_Click()
On Error GoTo Err_cmdCancel_Click
' close form
DoCmd.Close acForm, Me.Name
Exit_cmdCancel_Click:
Exit Sub
Err_cmdCancel_Click:
MsgBox Err.Description
Resume Exit_cmdCancel_Click
End Sub
' print cheques
Private Sub cmdPrint_Click()
On Error GoTo Err_cmdPrint_Click
If DCount("lngTrnID", "tblTransaction", "blnTrnChequeRequired = True") = 0 Then
MsgBox "No cheques to be printed.", vbExclamation, "Print Cheques"
cmdCancel_Click
Exit Sub
End If
' validate cheque no
If Not IsNumeric(Nz(Me.txtFirstChequeNo)) Then
MsgBox "Invalid first cheque number.", vbExclamation, "Print Cheques"
Me.txtFirstChequeNo.SetFocus
Exit Sub
End If
If Nz(Me.txtFirstChequeNo) < 1 Then
MsgBox "Invalid first cheque number.", vbExclamation, "Print Cheques"
Me.txtFirstChequeNo.SetFocus
Exit Sub
End If
' update trans with cheque no
' and confirm updated
UpdateTrans 1
[highlight] Do While IsNull(DLookup("lngTrnID", "tblTransaction", "strTrnOurCheque = '" & Format(CLng(Me.txtFirstChequeNo), "000000") & "'"))
DoEvents
Loop[/highlight]
' print cheques
'MsgBox "Load cheque stationery.", vbOKOnly + vbInformation, "Print Cheques"
Do
DoCmd.OpenReport "rptChequePrint", acViewNormal
DoEvents
' confirm
Select Case MsgBox("Have cheques printed correctly? Yes to update files. No to reprint. Cancel to abandon", vbYesNoCancel + vbDefaultButton3 + vbQuestion, "Print Cheques")
Case vbCancel
Exit Sub
Case vbYes
Exit Do
End Select
Loop
' update trans
UpdateTrans 2
' close form
DoCmd.Close acForm, Me.Name
Exit_cmdPrint_Click:
Exit Sub
Err_cmdPrint_Click:
MsgBox Err.Description
Resume Exit_cmdPrint_Click
End Sub