View Single Post
  #1  
Old June 26th, 2009, 10:30 PM posted to microsoft.public.access.reports
SuzyQ
external usenet poster
 
Posts: 217
Default using more than one detail record in one line on report

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