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 |
#2
|
|||
|
|||
using more than one detail record in one line on report
SuzyQ wrote:
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. 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 |
#3
|
|||
|
|||
using more than one detail record in one line on report
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" wrote: SuzyQ wrote: 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. 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 |
Thread Tools | |
Display Modes | |
|
|