using more than one detail record in one line on report

  • Thread starter Thread starter SuzyQ
  • Start date Start date
S

SuzyQ

I need a report for a schedule of projects. We enter the projects' start and
end dates into a table. I also allow multiple records for the same project.
This allows for multiple start/end dates with lulls in between. For the
output, I'm creating bars across the page that show the schedule with the
dates across the top of the page. I go out a set 16 weeks because that fits
on the page perfectly. The headings are the Sunday date of each week. It
will work perfectly if there is only one record per project, but when there
are multiple start/end dates for a project I don't want multiple details on
the report. I want one detail with the bars under the appropriate start/end
weeks.

See the code below to get an see what I've done so far. I just need to
figure out how to keep the same projects on the same line, but the
activate/color the bar for possible breaks in the schedule for which there
will be multiple records.

Option Compare Database
Option Explicit

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim intColor As Long
Dim intOffColor As Long

'color setting
intColor = getColor
intOffColor = 16777215 'white

If Me.txtWeek1 >= Me.txtStartDate And Me.txtWeek1 <= Me.txtEndDate Then
'turn on color for column 1
Me.lbl1.ForeColor = intColor
Me.lbl1.BackColor = intColor
Else
'white out color for column 1
Me.lbl1.ForeColor = intOffColor
Me.lbl1.BackColor = intOffColor
End If

If Me.txtWeek2 >= Me.txtStartDate And Me.txtWeek2 <= Me.txtEndDate Then
'turn on color for column 2
Me.lbl2.ForeColor = intColor
Me.lbl2.BackColor = intColor
Else
'white out color for column 2
Me.lbl2.ForeColor = intOffColor
Me.lbl2.BackColor = intOffColor
End If

If Me.txtWeek3 >= Me.txtStartDate And Me.txtWeek3 <= Me.txtEndDate Then
'turn on color for column 3
Me.lbl3.ForeColor = intColor
Me.lbl3.BackColor = intColor
Else
'white out color for column 3
Me.lbl3.ForeColor = intOffColor
Me.lbl3.BackColor = intOffColor
End If

If Me.txtWeek4 >= Me.txtStartDate And Me.txtWeek4 <= Me.txtEndDate Then
'turn on color for column 4
Me.lbl4.ForeColor = intColor
Me.lbl4.BackColor = intColor
Else
'white out color for column 4
Me.lbl4.ForeColor = intOffColor
Me.lbl4.BackColor = intOffColor
End If

If Me.txtWeek5 >= Me.txtStartDate And Me.txtWeek5 <= Me.txtEndDate Then
'turn on color for column 5
Me.lbl5.ForeColor = intColor
Me.lbl5.BackColor = intColor
Else
'white out color for column 5
Me.lbl5.ForeColor = intOffColor
Me.lbl5.BackColor = intOffColor
End If

If Me.txtWeek6 >= Me.txtStartDate And Me.txtWeek6 <= Me.txtEndDate Then
'turn on color for column 6
Me.lbl6.ForeColor = intColor
Me.lbl6.BackColor = intColor
Else
'white out color for column 6
Me.lbl6.ForeColor = intOffColor
Me.lbl6.BackColor = intOffColor
End If
If Me.txtWeek7 >= Me.txtStartDate And Me.txtWeek7 <= Me.txtEndDate Then
'turn on color for column 7
Me.lbl7.ForeColor = intColor
Me.lbl7.BackColor = intColor
Else
'white out color for column 7
Me.lbl7.ForeColor = intOffColor
Me.lbl7.BackColor = intOffColor
End If

If Me.txtWeek8 >= Me.txtStartDate And Me.txtWeek8 <= Me.txtEndDate Then
'turn on color for column 8
Me.lbl8.ForeColor = intColor
Me.lbl8.BackColor = intColor
Else
'white out color for column 8
Me.lbl8.ForeColor = intOffColor
Me.lbl8.BackColor = intOffColor
End If

If Me.txtWeek9 >= Me.txtStartDate And Me.txtWeek9 <= Me.txtEndDate Then
'turn on color for column 9
Me.lbl9.ForeColor = intColor
Me.lbl9.BackColor = intColor
Else
'white out color for column 9
Me.lbl9.ForeColor = intOffColor
Me.lbl9.BackColor = intOffColor
End If

If Me.txtWeek10 >= Me.txtStartDate And Me.txtWeek10 <= Me.txtEndDate Then
'turn on color for column 10
Me.lbl10.ForeColor = intColor
Me.lbl10.BackColor = intColor
Else
'white out color for column 10
Me.lbl10.ForeColor = intOffColor
Me.lbl10.BackColor = intOffColor
End If

If Me.txtWeek11 >= Me.txtStartDate And Me.txtWeek11 <= Me.txtEndDate Then
'turn on color for column 11
Me.lbl11.ForeColor = intColor
Me.lbl11.BackColor = intColor
Else
'white out color for column 11
Me.lbl11.ForeColor = intOffColor
Me.lbl11.BackColor = intOffColor
End If

If Me.txtWeek12 >= Me.txtStartDate And Me.txtWeek12 <= Me.txtEndDate Then
'turn on color for column 12
Me.lbl12.ForeColor = intColor
Me.lbl12.BackColor = intColor
Else
'white out color for column 12
Me.lbl12.ForeColor = intOffColor
Me.lbl12.BackColor = intOffColor
End If

If Me.txtWeek13 >= Me.txtStartDate And Me.txtWeek13 <= Me.txtEndDate Then
'turn on color for column 13
Me.lbl13.ForeColor = intColor
Me.lbl13.BackColor = intColor
Else
'white out color for column 13
Me.lbl13.ForeColor = intOffColor
Me.lbl13.BackColor = intOffColor
End If

If Me.txtWeek14 >= Me.txtStartDate And Me.txtWeek14 <= Me.txtEndDate Then
'turn on color for column 14
Me.lbl14.ForeColor = intColor
Me.lbl14.BackColor = intColor
Else
'white out color for column 14
Me.lbl14.ForeColor = intOffColor
Me.lbl14.BackColor = intOffColor
End If

If Me.txtWeek15 >= Me.txtStartDate And Me.txtWeek15 <= Me.txtEndDate Then
'turn on color for column 15
Me.lbl15.ForeColor = intColor
Me.lbl15.BackColor = intColor
Else
'white out color for column 15
Me.lbl15.ForeColor = intOffColor
Me.lbl15.BackColor = intOffColor
End If

If Me.txtWeek16 >= Me.txtStartDate And Me.txtWeek16 <= Me.txtEndDate Then
'turn on color for column 16
Me.lbl16.ForeColor = intColor
Me.lbl16.BackColor = intColor
Else
'white out color for column 16
Me.lbl16.ForeColor = intOffColor
Me.lbl16.BackColor = intOffColor
End If

End Sub

Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As
Integer)
Dim dteSunday As Date
Dim dteMonth As Integer

'set up the weekly column headings
dteSunday = SundayDate([Forms]![frmReports]![txtFromDate])
Me.txtWeek1 = dteSunday 'first week
Me.txtWeek2 = dteSunday + 7 '1 week later (7 * 1)
Me.txtWeek3 = dteSunday + 14 '2 weeks later (7 * 2)
Me.txtWeek4 = dteSunday + 21 '3 weeks later (7 * 3)
Me.txtWeek5 = dteSunday + 28 '4 weeks later (7 * 4)
Me.txtWeek6 = dteSunday + 35 '5 weeks later (7 * 5)
Me.txtWeek7 = dteSunday + 42 '6 weeks later (7 * 6)
Me.txtWeek8 = dteSunday + 49 '7 weeks later (7 * 7)
Me.txtWeek9 = dteSunday + 56 '8 weeks later (7 * 8)
Me.txtWeek10 = dteSunday + 63 '9 weeks later (7 * 9)
Me.txtWeek11 = dteSunday + 70 '10 weeks later (7 * 10)
Me.txtWeek12 = dteSunday + 77 '11 weeks later (7 * 11)
Me.txtWeek13 = dteSunday + 84 '12 weeks later (7 * 12)
Me.txtWeek14 = dteSunday + 91 '13 weeks later (7 * 13)
Me.txtWeek15 = dteSunday + 98 '14 weeks later (7 * 14)
Me.txtWeek16 = dteSunday + 105 '15 weeks later (7 * 15) - 16th week

'set up the monthly column headings
'get first month
dteMonth = Round((Month(Me.txtWeek1) + Month(Me.txtWeek2) +
Month(Me.txtWeek3) + Month(Me.txtWeek4)) / 4, 0)
Me.txtMonth1 = getMonth(dteMonth)

'get second month
dteMonth = dteMonth + 1
Me.txtMonth2 = getMonth(dteMonth)

'get third month
dteMonth = dteMonth + 1
Me.txtMonth3 = getMonth(dteMonth)

'get fourth month
dteMonth = dteMonth + 1
Me.txtMonth4 = getMonth(dteMonth)
End Sub
Private Function getMonth(pMonth As Integer) As String
Select Case pMonth
Case 1
getMonth = "January"
Case 2
getMonth = "February"
Case 3
getMonth = "March"
Case 4
getMonth = "April"
Case 5
getMonth = "May"
Case 6
getMonth = "June"
Case 7
getMonth = "July"
Case 8
getMonth = "August"
Case 9
getMonth = "September"
Case 10
getMonth = "October"
Case 11
getMonth = "November"
Case 12
getMonth = "December"
End Select
End Function

Private Function getColor() As Long
'get background color from labels on report
'to change priority color, make change to appropriate label
Select Case Me.txtPriority
Case 1 'high priority
getColor = Me.lblHigh.BackColor
Case 2 'Medium priority
getColor = Me.lblMedium.BackColor
Case 3 'Low priority
getColor = Me.lblLow.BackColor
Case 4 'Very low priority
getColor = Me.lblVeryLow.BackColor
End Select
End Function
 
SuzyQ said:
I need a report for a schedule of projects. We enter the projects' start and
end dates into a table. I also allow multiple records for the same project.
This allows for multiple start/end dates with lulls in between. For the
output, I'm creating bars across the page that show the schedule with the
dates across the top of the page. I go out a set 16 weeks because that fits
on the page perfectly. The headings are the Sunday date of each week. It
will work perfectly if there is only one record per project, but when there
are multiple start/end dates for a project I don't want multiple details on
the report. I want one detail with the bars under the appropriate start/end
weeks.
Click to expand...


Make sure you have a group (View menu - Sorting and
Grouping) for the project field with group header section
(if you don't want to see the group header, you can make it
invisible). Then add a text box (named txtNumDetails) to
the group header. Set the text box's expression to
=Count(*)

Next add an invisible text box (named txtLineNum) to the
detail section. Set its expression to =1 and RunningSum to
Over Group

Now you can add a line of code to the detail section's
Format event:
Me.MoveLayout = (txtLineNum = txtNumDetails)

BTW, you can shorten the detail format code a lot by using
this kind of syntax:

For k = 1 To 16
If Me("txtWeek" & k) >= Me.txtStartDate _
And Me("txtWeek" & k) <= Me.txtEndDate Then
'turn on color for column k
Me("lbl" & k).ForeColor = intColor
Me("lbl" & k).BackColor = intColor
Else
'white out color for column k
Me("lbl" & k).ForeColor = intOffColor
Me("lbl" & k).BackColor = intOffColor
End If
Next k

And similarly for the page header:

For k = 0 To 15
Me("txtWeek" & k) = dteSunday + k * 7 'k weeks later
Next k

I don't quite follow what the month column headings are
supposed to be, but I doubt that the Round function is doing
the job in all cases.

Also, unless you are using A97 or earlier, there is no need
for the getMonth function. Use the built in MonthName
function instead.
--
Marsh
MVP [MS Access]

See the code below to get an see what I've done so far. I just need to
figure out how to keep the same projects on the same line, but the
activate/color the bar for possible breaks in the schedule for which there
will be multiple records.

Option Compare Database
Option Explicit

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim intColor As Long
Dim intOffColor As Long

'color setting
intColor = getColor
intOffColor = 16777215 'white

If Me.txtWeek1 >= Me.txtStartDate And Me.txtWeek1 <= Me.txtEndDate Then
'turn on color for column 1
Me.lbl1.ForeColor = intColor
Me.lbl1.BackColor = intColor
Else
'white out color for column 1
Me.lbl1.ForeColor = intOffColor
Me.lbl1.BackColor = intOffColor
End If

If Me.txtWeek2 >= Me.txtStartDate And Me.txtWeek2 <= Me.txtEndDate Then
'turn on color for column 2
Me.lbl2.ForeColor = intColor
Me.lbl2.BackColor = intColor
Else
'white out color for column 2
Me.lbl2.ForeColor = intOffColor
Me.lbl2.BackColor = intOffColor
End If

If Me.txtWeek3 >= Me.txtStartDate And Me.txtWeek3 <= Me.txtEndDate Then
'turn on color for column 3
Me.lbl3.ForeColor = intColor
Me.lbl3.BackColor = intColor
Else
'white out color for column 3
Me.lbl3.ForeColor = intOffColor
Me.lbl3.BackColor = intOffColor
End If

If Me.txtWeek4 >= Me.txtStartDate And Me.txtWeek4 <= Me.txtEndDate Then
'turn on color for column 4
Me.lbl4.ForeColor = intColor
Me.lbl4.BackColor = intColor
Else
'white out color for column 4
Me.lbl4.ForeColor = intOffColor
Me.lbl4.BackColor = intOffColor
End If

If Me.txtWeek5 >= Me.txtStartDate And Me.txtWeek5 <= Me.txtEndDate Then
'turn on color for column 5
Me.lbl5.ForeColor = intColor
Me.lbl5.BackColor = intColor
Else
'white out color for column 5
Me.lbl5.ForeColor = intOffColor
Me.lbl5.BackColor = intOffColor
End If

If Me.txtWeek6 >= Me.txtStartDate And Me.txtWeek6 <= Me.txtEndDate Then
'turn on color for column 6
Me.lbl6.ForeColor = intColor
Me.lbl6.BackColor = intColor
Else
'white out color for column 6
Me.lbl6.ForeColor = intOffColor
Me.lbl6.BackColor = intOffColor
End If
If Me.txtWeek7 >= Me.txtStartDate And Me.txtWeek7 <= Me.txtEndDate Then
'turn on color for column 7
Me.lbl7.ForeColor = intColor
Me.lbl7.BackColor = intColor
Else
'white out color for column 7
Me.lbl7.ForeColor = intOffColor
Me.lbl7.BackColor = intOffColor
End If

If Me.txtWeek8 >= Me.txtStartDate And Me.txtWeek8 <= Me.txtEndDate Then
'turn on color for column 8
Me.lbl8.ForeColor = intColor
Me.lbl8.BackColor = intColor
Else
'white out color for column 8
Me.lbl8.ForeColor = intOffColor
Me.lbl8.BackColor = intOffColor
End If

If Me.txtWeek9 >= Me.txtStartDate And Me.txtWeek9 <= Me.txtEndDate Then
'turn on color for column 9
Me.lbl9.ForeColor = intColor
Me.lbl9.BackColor = intColor
Else
'white out color for column 9
Me.lbl9.ForeColor = intOffColor
Me.lbl9.BackColor = intOffColor
End If

If Me.txtWeek10 >= Me.txtStartDate And Me.txtWeek10 <= Me.txtEndDate Then
'turn on color for column 10
Me.lbl10.ForeColor = intColor
Me.lbl10.BackColor = intColor
Else
'white out color for column 10
Me.lbl10.ForeColor = intOffColor
Me.lbl10.BackColor = intOffColor
End If

If Me.txtWeek11 >= Me.txtStartDate And Me.txtWeek11 <= Me.txtEndDate Then
'turn on color for column 11
Me.lbl11.ForeColor = intColor
Me.lbl11.BackColor = intColor
Else
'white out color for column 11
Me.lbl11.ForeColor = intOffColor
Me.lbl11.BackColor = intOffColor
End If

If Me.txtWeek12 >= Me.txtStartDate And Me.txtWeek12 <= Me.txtEndDate Then
'turn on color for column 12
Me.lbl12.ForeColor = intColor
Me.lbl12.BackColor = intColor
Else
'white out color for column 12
Me.lbl12.ForeColor = intOffColor
Me.lbl12.BackColor = intOffColor
End If

If Me.txtWeek13 >= Me.txtStartDate And Me.txtWeek13 <= Me.txtEndDate Then
'turn on color for column 13
Me.lbl13.ForeColor = intColor
Me.lbl13.BackColor = intColor
Else
'white out color for column 13
Me.lbl13.ForeColor = intOffColor
Me.lbl13.BackColor = intOffColor
End If

If Me.txtWeek14 >= Me.txtStartDate And Me.txtWeek14 <= Me.txtEndDate Then
'turn on color for column 14
Me.lbl14.ForeColor = intColor
Me.lbl14.BackColor = intColor
Else
'white out color for column 14
Me.lbl14.ForeColor = intOffColor
Me.lbl14.BackColor = intOffColor
End If

If Me.txtWeek15 >= Me.txtStartDate And Me.txtWeek15 <= Me.txtEndDate Then
'turn on color for column 15
Me.lbl15.ForeColor = intColor
Me.lbl15.BackColor = intColor
Else
'white out color for column 15
Me.lbl15.ForeColor = intOffColor
Me.lbl15.BackColor = intOffColor
End If

If Me.txtWeek16 >= Me.txtStartDate And Me.txtWeek16 <= Me.txtEndDate Then
'turn on color for column 16
Me.lbl16.ForeColor = intColor
Me.lbl16.BackColor = intColor
Else
'white out color for column 16
Me.lbl16.ForeColor = intOffColor
Me.lbl16.BackColor = intOffColor
End If

End Sub

Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As
Integer)
Dim dteSunday As Date
Dim dteMonth As Integer

'set up the weekly column headings
dteSunday = SundayDate([Forms]![frmReports]![txtFromDate])
Me.txtWeek1 = dteSunday 'first week
Me.txtWeek2 = dteSunday + 7 '1 week later (7 * 1)
Me.txtWeek3 = dteSunday + 14 '2 weeks later (7 * 2)
Me.txtWeek4 = dteSunday + 21 '3 weeks later (7 * 3)
Me.txtWeek5 = dteSunday + 28 '4 weeks later (7 * 4)
Me.txtWeek6 = dteSunday + 35 '5 weeks later (7 * 5)
Me.txtWeek7 = dteSunday + 42 '6 weeks later (7 * 6)
Me.txtWeek8 = dteSunday + 49 '7 weeks later (7 * 7)
Me.txtWeek9 = dteSunday + 56 '8 weeks later (7 * 8)
Me.txtWeek10 = dteSunday + 63 '9 weeks later (7 * 9)
Me.txtWeek11 = dteSunday + 70 '10 weeks later (7 * 10)
Me.txtWeek12 = dteSunday + 77 '11 weeks later (7 * 11)
Me.txtWeek13 = dteSunday + 84 '12 weeks later (7 * 12)
Me.txtWeek14 = dteSunday + 91 '13 weeks later (7 * 13)
Me.txtWeek15 = dteSunday + 98 '14 weeks later (7 * 14)
Me.txtWeek16 = dteSunday + 105 '15 weeks later (7 * 15) - 16th week

'set up the monthly column headings
'get first month
dteMonth = Round((Month(Me.txtWeek1) + Month(Me.txtWeek2) +
Month(Me.txtWeek3) + Month(Me.txtWeek4)) / 4, 0)
Me.txtMonth1 = getMonth(dteMonth)

'get second month
dteMonth = dteMonth + 1
Me.txtMonth2 = getMonth(dteMonth)

'get third month
dteMonth = dteMonth + 1
Me.txtMonth3 = getMonth(dteMonth)

'get fourth month
dteMonth = dteMonth + 1
Me.txtMonth4 = getMonth(dteMonth)
End Sub
Private Function getMonth(pMonth As Integer) As String
Select Case pMonth
Case 1
getMonth = "January"
Case 2
getMonth = "February"
Case 3
getMonth = "March"
Case 4
getMonth = "April"
Case 5
getMonth = "May"
Case 6
getMonth = "June"
Case 7
getMonth = "July"
Case 8
getMonth = "August"
Case 9
getMonth = "September"
Case 10
getMonth = "October"
Case 11
getMonth = "November"
Case 12
getMonth = "December"
End Select
End Function

Private Function getColor() As Long
'get background color from labels on report
'to change priority color, make change to appropriate label
Select Case Me.txtPriority
Case 1 'high priority
getColor = Me.lblHigh.BackColor
Case 2 'Medium priority
getColor = Me.lblMedium.BackColor
Case 3 'Low priority
getColor = Me.lblLow.BackColor
Case 4 'Very low priority
getColor = Me.lblVeryLow.BackColor
End Select
End Function
Click to expand...
 
The round in the header shows the month "January" ... above the set of dates.
The dates might be 7/26, 8/2, 8/9, 8/16 etc the function takes (7+8+8+8)/4 =
7.75 - rounds that to 8 and getMonth returns August. It works every time (so
far).

Thanks for the suggestion for shortening detail code. I come from a foxpro
background and always had a way to do that in foxpro, but could never figure
out how to accomplish that in Access. That information is invaluable.

As for the rest of you suggestions, I came up with a solution to add data to
a table set up in such a way that it will do what I want. I wasn't happy
with having to add data to a table just for a report, so I will take some
time to figure out your suggestions, but right now I'm onto other projects.
Thanks again for the help.

Marshall Barton said:
SuzyQ said:
I need a report for a schedule of projects. We enter the projects' start and
end dates into a table. I also allow multiple records for the same project.
This allows for multiple start/end dates with lulls in between. For the
output, I'm creating bars across the page that show the schedule with the
dates across the top of the page. I go out a set 16 weeks because that fits
on the page perfectly. The headings are the Sunday date of each week. It
will work perfectly if there is only one record per project, but when there
are multiple start/end dates for a project I don't want multiple details on
the report. I want one detail with the bars under the appropriate start/end
weeks.
Click to expand...


Make sure you have a group (View menu - Sorting and
Grouping) for the project field with group header section
(if you don't want to see the group header, you can make it
invisible). Then add a text box (named txtNumDetails) to
the group header. Set the text box's expression to
=Count(*)

Next add an invisible text box (named txtLineNum) to the
detail section. Set its expression to =1 and RunningSum to
Over Group

Now you can add a line of code to the detail section's
Format event:
Me.MoveLayout = (txtLineNum = txtNumDetails)

BTW, you can shorten the detail format code a lot by using
this kind of syntax:

For k = 1 To 16
If Me("txtWeek" & k) >= Me.txtStartDate _
And Me("txtWeek" & k) <= Me.txtEndDate Then
'turn on color for column k
Me("lbl" & k).ForeColor = intColor
Me("lbl" & k).BackColor = intColor
Else
'white out color for column k
Me("lbl" & k).ForeColor = intOffColor
Me("lbl" & k).BackColor = intOffColor
End If
Next k

And similarly for the page header:

For k = 0 To 15
Me("txtWeek" & k) = dteSunday + k * 7 'k weeks later
Next k

I don't quite follow what the month column headings are
supposed to be, but I doubt that the Round function is doing
the job in all cases.

Also, unless you are using A97 or earlier, there is no need
for the getMonth function. Use the built in MonthName
function instead.
--
Marsh
MVP [MS Access]

See the code below to get an see what I've done so far. I just need to
figure out how to keep the same projects on the same line, but the
activate/color the bar for possible breaks in the schedule for which there
will be multiple records.

Option Compare Database
Option Explicit

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim intColor As Long
Dim intOffColor As Long

'color setting
intColor = getColor
intOffColor = 16777215 'white

If Me.txtWeek1 >= Me.txtStartDate And Me.txtWeek1 <= Me.txtEndDate Then
'turn on color for column 1
Me.lbl1.ForeColor = intColor
Me.lbl1.BackColor = intColor
Else
'white out color for column 1
Me.lbl1.ForeColor = intOffColor
Me.lbl1.BackColor = intOffColor
End If

If Me.txtWeek2 >= Me.txtStartDate And Me.txtWeek2 <= Me.txtEndDate Then
'turn on color for column 2
Me.lbl2.ForeColor = intColor
Me.lbl2.BackColor = intColor
Else
'white out color for column 2
Me.lbl2.ForeColor = intOffColor
Me.lbl2.BackColor = intOffColor
End If

If Me.txtWeek3 >= Me.txtStartDate And Me.txtWeek3 <= Me.txtEndDate Then
'turn on color for column 3
Me.lbl3.ForeColor = intColor
Me.lbl3.BackColor = intColor
Else
'white out color for column 3
Me.lbl3.ForeColor = intOffColor
Me.lbl3.BackColor = intOffColor
End If

If Me.txtWeek4 >= Me.txtStartDate And Me.txtWeek4 <= Me.txtEndDate Then
'turn on color for column 4
Me.lbl4.ForeColor = intColor
Me.lbl4.BackColor = intColor
Else
'white out color for column 4
Me.lbl4.ForeColor = intOffColor
Me.lbl4.BackColor = intOffColor
End If

If Me.txtWeek5 >= Me.txtStartDate And Me.txtWeek5 <= Me.txtEndDate Then
'turn on color for column 5
Me.lbl5.ForeColor = intColor
Me.lbl5.BackColor = intColor
Else
'white out color for column 5
Me.lbl5.ForeColor = intOffColor
Me.lbl5.BackColor = intOffColor
End If

If Me.txtWeek6 >= Me.txtStartDate And Me.txtWeek6 <= Me.txtEndDate Then
'turn on color for column 6
Me.lbl6.ForeColor = intColor
Me.lbl6.BackColor = intColor
Else
'white out color for column 6
Me.lbl6.ForeColor = intOffColor
Me.lbl6.BackColor = intOffColor
End If
If Me.txtWeek7 >= Me.txtStartDate And Me.txtWeek7 <= Me.txtEndDate Then
'turn on color for column 7
Me.lbl7.ForeColor = intColor
Me.lbl7.BackColor = intColor
Else
'white out color for column 7
Me.lbl7.ForeColor = intOffColor
Me.lbl7.BackColor = intOffColor
End If

If Me.txtWeek8 >= Me.txtStartDate And Me.txtWeek8 <= Me.txtEndDate Then
'turn on color for column 8
Me.lbl8.ForeColor = intColor
Me.lbl8.BackColor = intColor
Else
'white out color for column 8
Me.lbl8.ForeColor = intOffColor
Me.lbl8.BackColor = intOffColor
End If

If Me.txtWeek9 >= Me.txtStartDate And Me.txtWeek9 <= Me.txtEndDate Then
'turn on color for column 9
Me.lbl9.ForeColor = intColor
Me.lbl9.BackColor = intColor
Else
'white out color for column 9
Me.lbl9.ForeColor = intOffColor
Me.lbl9.BackColor = intOffColor
End If

If Me.txtWeek10 >= Me.txtStartDate And Me.txtWeek10 <= Me.txtEndDate Then
'turn on color for column 10
Me.lbl10.ForeColor = intColor
Me.lbl10.BackColor = intColor
Else
'white out color for column 10
Me.lbl10.ForeColor = intOffColor
Me.lbl10.BackColor = intOffColor
End If

If Me.txtWeek11 >= Me.txtStartDate And Me.txtWeek11 <= Me.txtEndDate Then
'turn on color for column 11
Me.lbl11.ForeColor = intColor
Me.lbl11.BackColor = intColor
Else
'white out color for column 11
Me.lbl11.ForeColor = intOffColor
Me.lbl11.BackColor = intOffColor
End If

If Me.txtWeek12 >= Me.txtStartDate And Me.txtWeek12 <= Me.txtEndDate Then
'turn on color for column 12
Me.lbl12.ForeColor = intColor
Me.lbl12.BackColor = intColor
Else
'white out color for column 12
Me.lbl12.ForeColor = intOffColor
Me.lbl12.BackColor = intOffColor
End If

If Me.txtWeek13 >= Me.txtStartDate And Me.txtWeek13 <= Me.txtEndDate Then
'turn on color for column 13
Me.lbl13.ForeColor = intColor
Me.lbl13.BackColor = intColor
Else
'white out color for column 13
Me.lbl13.ForeColor = intOffColor
Me.lbl13.BackColor = intOffColor
End If

If Me.txtWeek14 >= Me.txtStartDate And Me.txtWeek14 <= Me.txtEndDate Then
'turn on color for column 14
Me.lbl14.ForeColor = intColor
Me.lbl14.BackColor = intColor
Else
'white out color for column 14
Me.lbl14.ForeColor = intOffColor
Me.lbl14.BackColor = intOffColor
End If

If Me.txtWeek15 >= Me.txtStartDate And Me.txtWeek15 <= Me.txtEndDate Then
'turn on color for column 15
Me.lbl15.ForeColor = intColor
Me.lbl15.BackColor = intColor
Else
'white out color for column 15
Me.lbl15.ForeColor = intOffColor
Me.lbl15.BackColor = intOffColor
End If

If Me.txtWeek16 >= Me.txtStartDate And Me.txtWeek16 <= Me.txtEndDate Then
'turn on color for column 16
Me.lbl16.ForeColor = intColor
Me.lbl16.BackColor = intColor
Else
'white out color for column 16
Me.lbl16.ForeColor = intOffColor
Me.lbl16.BackColor = intOffColor
End If

End Sub

Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As
Integer)
Dim dteSunday As Date
Dim dteMonth As Integer

'set up the weekly column headings
dteSunday = SundayDate([Forms]![frmReports]![txtFromDate])
Me.txtWeek1 = dteSunday 'first week
Me.txtWeek2 = dteSunday + 7 '1 week later (7 * 1)
Me.txtWeek3 = dteSunday + 14 '2 weeks later (7 * 2)
Me.txtWeek4 = dteSunday + 21 '3 weeks later (7 * 3)
Me.txtWeek5 = dteSunday + 28 '4 weeks later (7 * 4)
Me.txtWeek6 = dteSunday + 35 '5 weeks later (7 * 5)
Me.txtWeek7 = dteSunday + 42 '6 weeks later (7 * 6)
Me.txtWeek8 = dteSunday + 49 '7 weeks later (7 * 7)
Me.txtWeek9 = dteSunday + 56 '8 weeks later (7 * 8)
Me.txtWeek10 = dteSunday + 63 '9 weeks later (7 * 9)
Me.txtWeek11 = dteSunday + 70 '10 weeks later (7 * 10)
Me.txtWeek12 = dteSunday + 77 '11 weeks later (7 * 11)
Me.txtWeek13 = dteSunday + 84 '12 weeks later (7 * 12)
Me.txtWeek14 = dteSunday + 91 '13 weeks later (7 * 13)
Me.txtWeek15 = dteSunday + 98 '14 weeks later (7 * 14)
Me.txtWeek16 = dteSunday + 105 '15 weeks later (7 * 15) - 16th week

'set up the monthly column headings
'get first month
dteMonth = Round((Month(Me.txtWeek1) + Month(Me.txtWeek2) +
Month(Me.txtWeek3) + Month(Me.txtWeek4)) / 4, 0)
Me.txtMonth1 = getMonth(dteMonth)

'get second month
dteMonth = dteMonth + 1
Me.txtMonth2 = getMonth(dteMonth)

'get third month
dteMonth = dteMonth + 1
Me.txtMonth3 = getMonth(dteMonth)

'get fourth month
dteMonth = dteMonth + 1
Me.txtMonth4 = getMonth(dteMonth)
End Sub
Private Function getMonth(pMonth As Integer) As String
Select Case pMonth
Case 1
getMonth = "January"
Case 2
getMonth = "February"
Case 3
getMonth = "March"
Case 4
getMonth = "April"
Case 5
getMonth = "May"
Case 6
getMonth = "June"
Case 7
getMonth = "July"
Case 8
getMonth = "August"
Case 9
Click to expand...
Click to expand...
 
Back
Top