Not sure if this is the same question you asked more recently. I'm not sure
which report this is based on. If it is the rotation report and your bar
would extend beyond the right margins or need to continue on a new line, you
would need to modify your record source to create multiple records from a
single record.
--
Duane Hookom
MS Access MVP
--
"Jesse" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
I've been tasked to create an Outlook-like calendar that shows the
lenght of various projects over several days or weeks. Based on Duane
Hookum calendar sample, I managed to create the pseudo-monthly view and
the projects in it. If the projects do not go beyond a week, it's all
good. However, if the projects go beyond a week I get into trouble. I
need to figure how to extend the days that fall out of the week when
the project starts. I believe that the approach I took would not let
me do so. The steps I took where the following:
1. Created a query (with date parameters) as the data source.
Following is the query:
PARAMETERS [Starting Date] DateTime, [Ending Date] DateTime;
SELECT DateAdd("d",-Weekday([dtBegin]),([dtBegin])+1) AS WeekOf,
tblProjectSchedule.dtBegin, tblProjectSchedule.dtEnd,
tblProjectSchedule.lutxtProjectID, tblProjectSchedule.txtDescription
FROM tblProjectSchedule WHERE
(((DateAdd("d",-Weekday([dtBegin]),([dtBegin])+1)) Between [Starting
Date] And [Ending Date])) ORDER BY
DateAdd("d",-Weekday([dtBegin]),([dtBegin])+1);
2. I grouped the report by the WeekOf field. On the group header I
placed seven controls to represent every day of the week. Then I added
the following code:
Option Compare Database
Option Explicit
Const cnTwips = 1440
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
' Comments :
' Parameters:
' Created : 03 Mar 2006 07:36 JA
' Modified :
' --------------------------------------------------
On Error GoTo ErrorHandler
Dim sngOneDay As Single
Dim sngWidth As Single
Dim sngLeft As Single
Dim sngPageWidth As Single
Dim sngPageTwips As Single
Dim sngWidthDiff As Single
sngPageWidth = 9.9167 'Page size
sngPageTwips = sngPageWidth * cnTwips 'Page size as twips
sngOneDay = 2040 'number of twips in one day
sngLeft = DateDiff("d", Me.WeekOf, Me.dtBegin) * sngOneDay
Me.Project.Left = sngLeft
sngWidth = DateDiff("d", Me.dtBegin, Me.dtEnd) * sngOneDay
If sngWidth = 0 Then
sngWidth = sngOneDay
End If
sngWidthDiff = sngPageTwips - sngLeft
If sngWidth > sngWidthDiff Then
Me.Project.Width = sngWidthDiff
Else
Me.Project.Width = sngWidth
End If
Debug.Print Me.Project
Debug.Print vbTab & "Top: " & Project.Top
Debug.Print vbTab & "Left: " & Project.Left
Debug.Print vbTab & "Width: " & Project.Width
Debug.Print vbTab & "Height: " & Project.Height
Debug.Print vbTab & "Count: " & FormatCount
ExitHandler:
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & vbNewLine & Err.Description &
vbNewLine & "In Detail_Format."
Resume ExitHandler
End Sub
Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
' Comments :
' Parameters:
' Created : 04 Mar 2006 18:17 JA
' Modified :
' --------------------------------------------------
On Error GoTo ErrorHandler
Me.ScaleMode = 1
Me.ForeColor = 0
'Repeat the following line of code for each vertical line
' 1*1440 represents 1 inch
Me.Line (0 * 1440, 0)-(0 * 1440, 14400) 'Draws line at Left Margin
Me.Line (9.9167 * 1440, 0)-(9.9167 * 1440, 14400) 'At Rigth inch
Me.Line (1.4167 * 1440, 0)-(1.4167 * 1440, 14400)
Me.Line (2.8333 * 1440, 0)-(2.8333 * 1440, 14400)
Me.Line (4.25 * 1440, 0)-(4.25 * 1440, 14400)
Me.Line (5.6667 * 1440, 0)-(5.6667 * 1440, 14400)
Me.Line (7.0833 * 1440, 0)-(7.0833 * 1440, 14400)
Me.Line (8.5 * 1440, 0)-(8.5 * 1440, 14400)
ExitHandler:
Exit Sub
ErrorHandler:
MsgBox "Error " & Err.Number & vbNewLine & Err.Description &
vbNewLine & "In Detail_Print."
Resume ExitHandler
End Sub
3. With some test data that display OK on the screen, I recorded the
following values from the control.
GET-06-277: Muestreo de suelo
Top: 0
Left: 6120
Width: 4080
Height: 300
Count: 1
GET-05-269: Muestreo de suelo
Top: 0
Left: 6120
Width: 4080
Height: 300
Count: 1
GET-06-276: Direct Push
Top: 0
Left: 2040
Width: 2040
Height: 300
Count: 1
GET-06-277: Excavación y remoción de agua del tanque
Top: 0
Left: 6120
Width: 4080
Height: 300
Count: 1
GET-06-274: Geoprobe services
Top: 0
Left: 2040
Width: 12240
Height: 300
Count: 1
The last group entry was cut to accomodate the paper lenght but in
reality it should run over the next week. This is the place where I
stumble. Looking for ideas on how I might tackle it. Thanks.
Jesse
|
Similar Threads
