[code]'On Open, this report determines the state of the form and adjusts various
'things based on that. If form not found then it defaults to showing :
' Main Stock Products only
' Costs
' Opal Column Prices
' Sorting must be handled by multiple reports.
Private Sub Report_Open(Cancel As Integer)
Dim intSort As Integer, intSelRange As Integer, intCols As Integer ', intPCs As Integer
Dim intSpare As Integer, intShift As Integer
Dim strSort As String, strWork As String, strType As String
Dim strPC1 As String, strPC2 As String
Dim blnCosts As Boolean, blnReplacement As Boolean, blnAll As Boolean
Dim blnVisible As Boolean
On Error Resume Next
'If next line fails then intFrom stays 0 - otherwise it will be > 0
intFrom = Forms("frm" & conStub).fraFrom
On Error GoTo 0
If intFrom = 0 Then
'Form not found
intSelRange = 1
blnCosts = True
blnReplacement = True
blnAll = False
intSort = 1
strSort = "Prod Group then Code"
intFrom = 3
intCols = 2
'intPCs = 1
dblPC2 = 100 / 60 '40% GPM
Else
'Form found - use settings from form
With Forms("frm" & conStub)
intSelRange = IIf(.chkLawForms, 2, 0) + IIf(.chkMainStock, 1, 0)
blnCosts = .chkShowCost
blnReplacement = .chkReplacement
blnAll = .chkAll
intSort = .fraSort
Select Case intSort
Case 1
strSort = .lblPGrpCode.Caption
Case 2
strSort = .lblPGrpDesc.Caption
Case 3
strSort = .lblProdCode.Caption
Case 4
strSort = .lblProdDesc.Caption
End Select
intCols = IIf(blnReplacement, 1, 0)
Select Case intFrom
Case 1
If Not blnReplacement Then intCols = 6
Case 2, 3
intCols = intCols + 1
strPC1 = Nz(.txtPC1, "")
dblPC1 = IIf(intFrom = 2, (100 + CDbl(strPC1)) / 100, _
100 / (100 - CDbl(strPC1)))
If blnReplacement Then
'First PC shows in second column
strPC2 = strPC1
dblPC2 = dblPC1
ElseIf (.txtPC2.Enabled And Not IsNull(.txtPC2)) Then
'We may have a second PC column
intCols = 2
strPC2 = .txtPC2
dblPC2 = IIf(intFrom = 2, (100 + CDbl(strPC2)) / 100, _
100 / (100 - CDbl(strPC2)))
End If
End Select
End With
End If
'First step is to change the Recordsource if required...
If blnAll Then Me.RecordSource = "qry" & conStub & "All"
'Set up Sorting & Grouping
'Only show PGroupHdr if sorting primarily by PGroup and turn triggering
'to as few as possible (using Prefix) if not showing (otherwise Each)
'Assume both levels must be set with different fields regardless
PGroupHdr.Visible = (intSort < 3)
'.GroupOn ==> 0 = Each; 1 = Prefix
GroupLevel(1).GroupOn = IIf(intSort < 3, 0, 1)
Select Case intSort
Case 1
GroupLevel(0).ControlSource = "PGroup"
GroupLevel(1).ControlSource = "Product"
Case 2
GroupLevel(0).ControlSource = "PGroup"
GroupLevel(1).ControlSource = "ProdDesc"
Case 3
GroupLevel(0).ControlSource = "Product"
GroupLevel(1).ControlSource = "PGroup"
Case 4
GroupLevel(0).ControlSource = "ProdDesc"
GroupLevel(1).ControlSource = "PGroup"
End Select
With txtTitle
Select Case intFrom
Case 1
strType = "Column" & IIf(blnReplacement, " 1 Only", "s")
Case 2
strType = "Markups"
Case 3
strType = "GPMs"
End Select
.ControlSource = MultiReplace(.Tag, "%S", strSort, "%T", strType)
End With
If intSelRange = 3 Then
FilterOn = False
Else
FilterOn = True
strWork = Split(Expression:=conFilters, Delimiter:="|")(intSelRange - 1)
Filter = Replace(strWork, "%L", conLawForms)
End If
lblCost.Visible = blnCosts
'Adjust widths and visibilities of various fields
'Some field attribute may need to be adjusted from their starting values
'Ignore some starting values in the design as they are just to fit visibly
'ProdDesc.Width = 7.354cm (4,170) conDescWidth
'Unit.Width = 1.24cm (703) conUnitWidth
'PriceFields.Width = 1.199cm (680) conPriceWidth
'Expand width of Description in all scenarios except when both the Cost AND
'All Columns are shown.
Me.lblProdDesc.Width = conDescWidth + IIf(blnCosts And (intCols = 6), _
0, Me.lblCost.Width)
'Set captions, width and visibility for Column fields used
Me.lblPrice1.Caption = Replace(conColLbl, "%N", "1")
Me.txtPrice1.ControlSource = "Price1"
Me.lblPrice1.Width = conPriceWidth
Me.lblPrice2.Caption = Replace(conColLbl, "%N", "2")
Me.txtPrice2.ControlSource = "Price2"
Me.lblPrice2.Width = conPriceWidth
strWork = Replace(strType, "s", "") & vbCrLf
If intFrom > 1 Then
Me.txtPrice2.ControlSource = "=Round([Cost]*" & dblPC2 & ",2)"
If blnReplacement Then
'First column same as default (Price1)
Me.lblPrice2.Caption = MultiReplace("Min Sell%L%N%", "%N", strPC1, _
"%L", vbCrLf)
Else
Me.lblPrice1.Caption = strWork & strPC1 & "%"
Me.txtPrice1.ControlSource = "=Round([Cost]*" & dblPC1 & ",2)"
Me.lblPrice2.Caption = strWork & strPC2 & "%"
End If
End If
Me.lblPrice2.Visible = (intCols > 1)
'Special handling for new style report (chkReplacement = True)
Me.lblReplacement.Visible = blnReplacement
'Handle last 4 column fields (Only leave required fields visible)
blnVisible = (intCols > 2)
Me.lblPrice3.Visible = blnVisible
Me.lblPrice4.Visible = blnVisible
Me.lblPrice5.Visible = blnVisible
Me.lblPrice6.Visible = blnVisible
Me.txtPrice3.Visible = blnVisible
Me.txtPrice4.Visible = blnVisible
Me.txtPrice5.Visible = blnVisible
Me.txtPrice6.Visible = blnVisible
'Build up positions and mirror widths & visibilities
intSpare = (Me.Width - BuildUp() - 10) / 4
If (intCols < 6) And (intSpare > 10) Then
If intSpare > conExtend Then
intShift = 2 * (intSpare - conExtend)
intSpare = conExtend
Else
intShift = 0
End If
Me.lblUnit.Width = conUnitWidth + intSpare
Me.lblCost.Width = conPriceWidth + intSpare
Me.lblPrice1.Width = conPriceWidth + intSpare
Me.lblPrice2.Width = conPriceWidth + intSpare
Call BuildUp(intShift)
End If
'Set up Report ID & date for bottom left corner of report
strDate = DLookup(Expr:="
- ", _
-
Domain:="[tblReport]", _
-
Criteria:="[ReportName]='" & Name & "'") & _
-
Format(Date, " - d mmmm yyyy")
-
End Sub