Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chriss Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Print a running form

Status
Not open for further replies.
FatShaft

FatShaft

Technical User
Joined
Mar 2, 2003
Messages
4
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.)
 
Sort by date Sort by votes
Create a Print Macro and Place it as a last statement inside the Loop
 
Upvote 0 Downvote
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.
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
If you dont mind can you please tell what you have put in "PrintF" macro
 
Upvote 0 Downvote
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
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Kennelbloke
  • Locked
  • Solved
Subform not updating in parent form
Replies
10
Views
1K
Kennelbloke
Kennelbloke
TrekBiker
  • Locked
  • Question Question
Running query with parameter from Inputbox
Replies
8
Views
1K
TrekBiker
TrekBiker
TrekBiker
  • Locked
  • Question Question
Form Data Not Updating
Replies
6
Views
998
dhookom
dhookom
TrekBiker
  • Locked
  • Question Question
Forcing Form Updates
Replies
2
Views
788
TrekBiker
TrekBiker
MattGreer
  • Locked
  • Question Question
Add Field Description to a Form
Replies
5
Views
648
Andrzejek
Andrzejek

Part and Inventory Search

Sponsor

Back
Top