Print a running form

[FatShaft]

I have a complex form that draws data from several tables using DAO. I can print a single instance of the form from the file menu. I have now put the code behind the form into a loop that produces a separate page for multiple names. I cannot find a way to print the form each time it is populated during the loop. (apart from stopping the code, switching to the form and manually printing it.)

 

[HandsOnAccess]

Create a Print Macro and Place it as a last statement inside the Loop

 

[FatShaft]

I tried the print macro but I still receive Error 2585 - this action can't be carried out while processing a form or report event.

 

[HandsOnAccess]

Please paste the code here

 

[FatShaft]

Private Sub Form_Open(Cancel As Integer)
' Print entire set of home group Main Forms

Dim Message, Title, Default, HomeGBox, HomeG As String
Dim dbsRV As Database
Dim qdfHomeG As QueryDef

Dim BlankRow As Integer
Dim rstStuds As DAO.Recordset
Dim rst1 As DAO.Recordset
Dim Tables(7) As String 'sets up array for each year's data tables
Tables(1) = "Data06"
Tables(2) = "Data07"
Tables(3) = "Data08"
Tables(4) = "Data09"
Tables(5) = "Data10"
Tables(6) = "Data11"
Tables(7) = "Data12"

Set dbsRV = CurrentDb
'Get students by creating recordset of a homegroup and then cycling through them
Message = "Enter Home Group to Print (e.g. 56L)" ' Set prompt.
Title = "HOME GROUP" ' Set title.
'Default = "1" ' Set default.
' Display message, title, and default value.
HomeGBox = InputBox(Message, Title, Default)
IntYear = right(year(Date), 2)
StudTable = "Data" & IntYear
With dbsRV
Set qdfHomeG = .CreateQueryDef("", "Parameters HomeG text;" & _
"SELECT * FROM [" & StudTable & "]" & _
"WHERE (Class = HomeG)") 'Class is table field
'set query def parameters classg is input variable above
qdfHomeG!HomeG = HomeGBox 'Me.GradeOption.Value value of option box on form


With qdfHomeG
'On Error Resume Next 'could be a problem with missing students - should trap???
'Set rstStuds = dbsRV.OpenRecordset("", dbOpenDynaset)

Set rstStuds = .OpenRecordset(dbOpenDynaset)
With rstStuds 'recordset containing query records

.MoveFirst
.MoveLast
.MoveFirst
recCount = rstStuds.RecordCount


'******************************************************************************************
'start loop through rstStuds and complete a form and print it for each student.
'********************************************************************************************
With dbsRV
Do While Not rstStuds.EOF

Dim qdfTemp As QueryDef
BlankRow = 0 ' counter in case all rows are empty - provide error message feedback

'On Error Resume Next

'define temporary query to select student from each year's table
For i = 1 To 7 'iterates through each table for each year 2006 -> 2012
Set qdfTemp = .CreateQueryDef("", "Parameters gn text, sn text;" & _
"SELECT * FROM [" & Tables(i) & "]" & _
"WHERE (((Gname = gn) AND (Sname = sn)))")
'set query def parameters
qdfTemp!gn = rstStuds("Gname")
qdfTemp!sn = rstStuds("Sname")



With qdfTemp

Set rst1 = .OpenRecordset(dbOpenDynaset)
With rst1
' .MoveFirst
' .MoveLast
' .MoveFirst
If rst1.EOF Then 'blank out text controls on the form if no data for this student/year
'all controls set in ersatz array form
BlankRow = BlankRow + 1
Me.Controls("Tchr" & i) = " "
Me.Controls("Count" & i) = " "
Me.Controls("PlaceVal" & i) = " "
Me.Controls("Gr" & i) = " "
Me.Controls("Yr" & i) = " "
Me.Controls("XYr" & i) = " "
Me.Controls("AddSub" & i) = " "
Me.Controls("MultDiv" & i) = " "
Me.Controls("AcerMay" & i) = " "
Me.Controls("AcerNov" & i) = " "
Me.Controls("BurtMay" & i) = " "
Me.Controls("BurtNov" & i) = " "
Me.Controls("HolbMay" & i) = " "
Me.Controls("HolbNov" & i) = " "
Me.Controls("SaspMay" & i) = " "
Me.Controls("SaspNov" & i) = " "
Me.Controls("TorchMay" & i) = " "
Me.Controls("TorchNov" & i) = " "
Me.Controls("WriteMay" & i) = " "
Me.Controls("WriteNov" & i) = " "
Me.Controls("ReadMay" & i) = " "
Me.Controls("ReadNov" & i) = " "
Me.Controls("XGr" & i) = " "
Me.Controls("RdRec" & i).BackColor = 16777215
Me.Controls("LitSupp" & i).BackColor = 16777215
Me.Controls("MathSupp" & i).BackColor = 16777215
Me.Controls("Integ" & i).BackColor = 16777215
Me.Controls("Guid" & i).BackColor = 16777215
Me.Controls("Speech" & i).BackColor = 16777215
Me.Controls("Med" & i) = " "
Me.Controls("Curric" & i) = " "
Me.Controls("AgeMay" & i) = " "
Me.Controls("AgeNov" & i) = " "
Me.Controls("AimMath" & i) = " "
Me.Controls("AimSpell" & i) = " "
Me.Controls("AimRead" & i) = " "
Me.Controls("AimWrite" & i) = " "

Else 'if there is student data for this year then display it

Me.StudNameF = UCase(rst1("Gname")) & " " & rst1("Sname")
Me.DOBF = rst1("DOB")
Me.Addr1F = rst1("Street")
Me.Addr2F = rst1("Suburb")
Me.ZipF = rst1("ZIP")
Me.MumNameF = rst1("MumGname") & " " & rst1("MumSname")

Me.DadNameF = rst1("DadGname") & " " & rst1("DadSname")

Me.PhoneF = rst1("Phone")

'start of ACHIEVEMENT DATA
Me.Controls("Tchr" & i) = (rst1("TchrGname")) & " " & (rst1("TchrSname"))
Me.Controls("Count" & i) = rst1("Counting")
Me.Controls("PlaceVal" & i) = rst1("PlaceValue")
Me.Controls("Gr" & i) = rst1("YearLevel")
Me.Controls("Yr" & i) = right(rst1("CYear"), 2)
Me.Controls("AddSub" & i) = rst1("AddSub")
Me.Controls("MultDiv" & i) = rst1("DivMult")
Me.Controls("AcerMay" & i) = rst1("AcerMathMay")
Me.Controls("AcerNov" & i) = rst1("AcerMathNov")
'age controls - reading and spelling ages - strip leading zeroes
If left(rst1("BurtMay"), 1) = "0" Then
Me.Controls("BurtMay" & i) = right(rst1("BurtMay"), 4)
Else
Me.Controls("BurtMay" & i) = rst1("BurtMay")
End If

If left(rst1("BurtNov"), 1) = "0" Then
Me.Controls("BurtNov" & i) = right(rst1("BurtNov"), 4)
Else
Me.Controls("BurtNov" & i) = rst1("BurtNov")
End If

If left(rst1("HolbMay"), 1) = "0" Then
Me.Controls("HolbMay" & i) = right(rst1("HolbMay"), 4)
Else
Me.Controls("HolbMay" & i) = rst1("HolbMay")
End If

If left(rst1("HolbNov"), 1) = "0" Then
Me.Controls("HolbNov" & i) = right(rst1("HolbNov"), 4)
Else
Me.Controls("HolbNov" & i) = rst1("HolbNov")
End If

If left(rst1("SaspMay"), 1) = "0" Then
Me.Controls("SaspMay" & i) = right(rst1("SaspMay"), 4)
Else
Me.Controls("SaspMay" & i) = rst1("SaspMay")
End If

If left(rst1("SaspNov"), 1) = "0" Then
Me.Controls("SaspNov" & i) = right(rst1("SaspNov"), 4)
Else
Me.Controls("SaspNov" & i) = rst1("SaspNov")
End If


Me.Controls("TorchMay" & i) = rst1("TorchMay")
Me.Controls("TorchNov" & i) = rst1("TorchNov")
'Me.Controls("WriteMay" & i) = rst1("WriteMay")
Me.Controls("WriteNov" & i) = rst1("WriteNov")
Me.Controls("ReadMay" & i) = rst1("ReadMay")
Me.Controls("ReadNov" & i) = rst1("ReadNov")
Me.Controls("XGr" & i) = rst1("YearLevel")
Me.Controls("XYr" & i) = right(rst1("CYear"), 2)
Me.Controls("AimMath" & i) = rst1("AIMmaths")
Me.Controls("AimSpell" & i) = rst1("AIMSpelling")
Me.Controls("AimRead" & i) = rst1("AIMReading")
Me.Controls("AimWrite" & i) = rst1("AIMWriting")

'start of EXTRA ASSISTANCE DATA

If rst1("ReadRec") = True Then
Me.Controls("RdRec" & i).BackColor = 255
Else
Me.Controls("RdRec" & i).BackColor = 16777215
End If

If rst1("LitSupp") = True Then
Me.Controls("LitSupp" & i).BackColor = 32768
Else
Me.Controls("LitSupp" & i).BackColor = 16777215
End If

If rst1("MathSupp") = True Then
Me.Controls("MathSupp" & i).BackColor = 16711935
Else
Me.Controls("MathSupp" & i).BackColor = 16777215
End If

If rst1("Integration") = True Then
Me.Controls("Integ" & i).BackColor = 1674448
Else
Me.Controls("Integ" & i).BackColor = 16777215
End If

If rst1("GuidOff") = True Then
Me.Controls("Guid" & i).BackColor = 33023
Else
Me.Controls("Guid" & i).BackColor = 16777215
End If

If rst1("Speech") = True Then
Me.Controls("Speech" & i).BackColor = 65408
Else
Me.Controls("Speech" & i).BackColor = 16777215
End If

If rst1.RecordCount < 1 Then 'blank out the controls
Me.Controls("RdRec" & i).BackColor = 16777215
Me.Controls("LitSupp" & i).BackColor = 16777215
Me.Controls("MathSupp" & i).BackColor = 16777215
Me.Controls("Integ" & i).BackColor = 16777215
Me.Controls("Speech" & i).BackColor = 16777215
Me.Controls("Guid" & i).BackColor = 16777215
End If



Me.Controls("Med" & i) = rst1("Medical")
Me.Controls("Curric" & i) = rst1("Curriculum")
Me.Controls("AgeMay" & i) = rst1("AgeMay")
Me.Controls("AgeNov" & i) = rst1("AgeNov")

End If
End With 'rst1
End With 'qdfTemp
Next i
DoCmd.RunMacro "PrintF"
Stop
rstStuds.MoveNext
Loop


End With 'rstStuds
End With 'QdfHomeG
End With 'dbsRV
End With 'dbsRV
rst1.Close
rstStuds.Close
End Sub

 

[HandsOnAccess]

If you dont mind can you please tell what you have put in "PrintF" macro

 

[FatShaft]

Thanks for your time on this - much appreciated.

Private Sub PrintF_Click()
On Error GoTo Err_PrintF_Click


DoCmd.PrintOut

Exit_PrintF_Click:
Exit Sub

Err_PrintF_Click:
MsgBox err.Description
Resume Exit_PrintF_Click

End Sub