If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
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 |
Thread Tools | |
Display Modes | |
|
|