Thank you all very much for your help with the class module question.
Further to your comments, I have put together my first class module (see end
of post). My question now is how you make it compulsory to provide an
argument when initializing an instance of the ZOS class (as I call the class
module).
For those keen to read more about my developments, please read below:
It is called ZOS and it used in my database for printing reports.
Basically you pass the rptid (from a table with contains all the reports) or
name(rptn) to the class module and in return it can provide you with a raft
of variables about the report (e.g. whether it has date fields, if you can
filter for these date fields, a bunch of boolean parameters (e.g. print on
letterheader), a default filter (defaultW), etc...).
The class also loads the filters for the report (either from the ZOS form or
from the P-ZOU table) and prints the report.
Thank you once more for your comments
Greetings from the roaring forties
Nicolaas
-----------------------------------------------------------------
Option Compare Database
Option Explicit
'allows you to manage reports
'must provide a RptID or a RptN
Dim MyRptN As String
Dim RST As Recordset
Dim MyRptId As Long
Property Let RptN(S As String)
'On Error GoTo err
'-----------------------------------
Set RST = CurrentDb.OpenRecordset("SELECT [T-ZOU].* FROM [T-ZOU] WHERE
([T-ZOU]![Dc]='" & S & "');")
MyRptN = S
MyRptId = RST.Fields("ID")
xit:
Exit Property
err:
Resume xit
End Property
Property Let RptID(REC As Long)
'On Error GoTo err
'-----------------------------------
Set RST = CurrentDb.OpenRecordset("SELECT [T-ZOU].* FROM [T-ZOU] WHERE
([T-ZOU]![Dc]='" & REC & "');")
MyRptId = REC
MyRptN = RST.Fields("Dc")
xit:
Exit Property
err:
Resume xit
End Property
Property Get HasDateFields() As Boolean
'on error goto err
'-----------------------------------
If Nz(RST.Fields("FFD"), "") <> "" Or Nz(RST.Fields("UFD"), "") <> ""
Then HasDateFields = True
xit:
Exit Property
err:
Resume xit
End Property
Property Get ParameterS(i As Byte) As String
'on error goto err
'-----------------------------------
If i < 1 Or i > 5 Then ParameterS = ""
ParameterS = RST.Fields("PR" & i)
xit:
Exit Property
err:
Resume xit
End Property
Property Get ParameterDefaultV(i As Byte) As Boolean
'on error goto err
'-----------------------------------
If i < 1 Or i > 5 Then ParameterDefaultV = ""
ParameterDefaultV = DLookup("[PA" & i & "]", "[P-ZOU]",
"[P-ZOU]![T-ZOU-ID]=" & MyRptId)
xit:
Exit Property
err:
Resume xit
End Property
Property Get RptD() As String
'on error goto err
'-----------------------------------
RptD = Trim(DLookup("[D]", "[T-ZOU]]", "[T-ZOU]![ID]=" & RptID))
xit:
Exit Property
err:
Resume xit
End Property
Property Get RptN() As String
'on error goto err
'-----------------------------------
RptN = MyRptN
xit:
Exit Property
err:
Resume xit
End Property
Property Get RptID() As Long
'on error goto err
'-----------------------------------
RptID = RST.Fields("ID")
xit:
Exit Property
err:
Resume xit
End Property
Property Get FromField() As String
'on error goto err
'-----------------------------------
FromField = RST.Fields("FFD")
xit:
Exit Property
err:
Resume xit
End Property
Property Get UntilField() As String
'on error goto err
'-----------------------------------
UntilField = RST.Fields("UFD")
xit:
Exit Property
err:
Resume xit
End Property
Property Get DefaultFromDays() As Integer
'on error goto err
'-----------------------------------
DefaultFromDays = DLookup("[FROM]", "[P-ZOU]", "[P-ZOU]![T-ZOU-ID]=" &
RptID)
xit:
Exit Property
err:
Resume xit
End Property
Property Get DefaultUntilDays() As Integer
'on error goto err
'-----------------------------------
DefaultUntilDays = DLookup("[UNTIL]", "[P-ZOU]", "[P-ZOU]![T-ZOU-ID]=" &
RptID)
xit:
Exit Property
err:
Resume xit
End Property
Property Get DataTablesCount() As Integer
'on error goto err
'-----------------------------------
DataTablesCount = DCount("[ID]", "[T-ZTC]", "[T-ZTC]![T-ZOU-ID]=" &
MyRptId & " and mkd(tabidtodc([T-ZTC]![T-TAB-ID1]))=true")
xit:
Exit Property
err:
Resume xit
End Property
Property Get ParameterTablesCount() As Integer
'on error goto err
'-----------------------------------
ParameterTablesCount = DCount("[ID]", "[T-ZTC]", "[T-ZTC]![T-ZOU-ID]=" &
MyRptId & " and ljd(tabdctoid([T-ZTC]![T-TAB-ID1]))=true")
xit:
Exit Property
err:
Resume xit
End Property
Property Get DefaultFromUntilFilter() As Boolean
'on error goto err
'-----------------------------------
If DefaultFromDays <> 0 Or DefaultUntilDays <> 0 Then
DefaultFromUntilFilter = True
End If
xit:
Exit Property
err:
Resume xit
End Property
Private Function DefaultW() As String
'on error goto err
'-----------------------------------
Dim W As String
'-----------------------------------
If DefaultFromUntilFilter = True Then
If Nz(UntilField, "") <> "" Then
W = "fsimdat(fromm(), untilm(), [" & FromField & "], [" &
UntilField & "])=true"
Else
If Nz(FromField, "") = "" Then
W = "[DAT] >= fromm() and [dat]<= untilm()"
Else
W = "[" & FromField & "] >= fromm() and [" & FromField &
"]<= untilm()"
End If
End If
End If
xit:
Exit Function
err:
Resume xit
End Function
Private Function ZosW() As String
On Error GoTo err
'-----------------------------------
Dim Wall As String
Dim TblN1 As String
Dim TblN2 As String
Dim W(10) As String
Dim Itm As Variant
Dim Itm1 As Variant
Dim Itm2 As Variant
Dim Ctl1 As Control
Dim Ctl2 As Control
Dim Ctl As Control
Dim Frm As Form
'-----------------------------------
Set Frm = Forms("A-ZOS")
If Nz(Frm.T_TAB_ID1, "") <> "" Then TblN1 = TabIDtoDc(Frm.T_TAB_ID1)
If Nz(Frm.T_TAB_ID2, "") <> "" Then TblN1 = TabIDtoDc(Frm.T_TAB_ID2)
Set Ctl = Frm.Controls("FILTER")
For Each Itm In Ctl.ItemsSelected
Select Case Ctl.ItemData(Itm)
Case 0
If Nz(Frm.UFD, "") <> "" Then
W(0) = "fsimdat(fromm(), untilm(), [" & Frm.FFD & "], ["
& Frm.UFD & "])=true"
Else
If Nz(Frm.FFD, "") = "" Then
W(0) = "[DAT] >= fromm() and [dat]<= untilm()"
Else
W(0) = "[" & Frm.FFD & "] >= fromm() and [" &
Frm.FFD & "]<= untilm()"
End If
End If
Case 10
If Nz(TblN1, "") <> "" Then
Set Ctl1 = Frm.Controls("TAB1")
For Each Itm1 In Ctl1.ItemsSelected
W(1) = W(1) & "[" & TblN1 & "-ID]=" &
Ctl1.ItemData(Itm1) & " OR "
Next Itm1
W(1) = Left(W(1), Len(W(1)) - 4)
End If
Case 20
If Nz(TblN2, "") <> "" Then
Set Ctl2 = Frm.Controls("TAB2")
For Each Itm2 In Ctl1.ItemsSelected
W(2) = W(2) & "[" & TblN2 & "-ID]=" &
Ctl1.ItemData(Itm2) & " OR "
Next Itm2
W(2) = Left(W(2), Len(W(2)) - 4)
End If
End Select
Next Itm
Wall = "(" & W(0) & ") AND (" & W(1) & ") AND (" & W(2) & ")"
Wall = FuTOD(Wall, "() AND (")
Wall = FuTOD(Wall, ") AND ()")
ZosW = Wall
xit:
Exit Function
err:
Resume xit
End Function
Private Function DefaultParameterVs() As String
'produces a string, e.g. 00100 where parameters 1, 2, 4 and 5 are false AND
parameter 3 = true
'this string can be passed to reports as the opening argument
'on error goto err
'-----------------------------------
Dim W As String
Dim i As Byte
'-----------------------------------
DefaultParameterVs = ""
For i = 1 To 5
If ParameterDefaultV(i) = True Then W = W & 1 Else W = W & 0
Next i
DefaultParameterVs = W
xit:
Exit Function
err:
Resume xit
End Function
Private Function ZosParameterVs() As String
'produces a string, e.g. 00100 where parameters 1, 2, 4 and 5 are false AND
parameter 3 = true
'this string can be passed to reports as the opening argument
'on error goto err
'-----------------------------------
Dim W As String
Dim i As Byte
Dim Frm As Form
Dim Ctl As Control
'-----------------------------------
ZosParameterVs = ""
i = 0
Set Frm = Forms("A-ZOS")
Set Ctl = Frm.Controls("FILTER")
For i = 1 To 5
If Ctl.ItemData(i).Selected = True Then
W = W & "1"
Else
W = W & "0"
End If
Next i
ZosParameterVs = W
xit:
Exit Function
err:
Resume xit
End Function
Sub OpenReport(FromZos As Boolean, ToPrinter As Boolean)
'on error goto err
'-----------------------------------
Dim W As String
Dim OpenArg As String
'-----------------------------------
If FromZos = True And IsLoaded("A-ZOS") = True Then
W = ZosW
OpenArg = ZosParameterVs
Else
If IsLoaded("A-TOC") = False Then
FMB (204)
GoTo xit
Else
W = DefaultW
OpenArg = DefaultParameterVs
Forms("A-TOC").from = DATE + DefaultFromDays
Forms("A-TOC").until = DATE + DefaultUntilDays
End If
End If
If ToPrinter = True Then
DoCmd.OpenReport RptN, acViewNormal, , W, acWindowNormal, OpenArg
Else
DoCmd.OpenReport RptN, acViewPreview, , W, acWindowNormal, OpenArg
End If
xit:
Exit Sub
err:
Resume xit
End Sub
---
Please immediately let us know (by phone or return email) if (a) this email
contains a virus
(b) you are not the intended recipient
(c) you consider this email to be spam.
We have done our utmost to make sure that
none of the above are applicable. THANK YOU
Checked by AVG anti-virus system (
http://www.grisoft.com).
Version: 6.0.692 / Virus Database: 453 - Release Date: 28/05/2004