Monthly gantt chart with days

  • Thread starter Thread starter Ryan Addams
  • Start date Start date
R

Ryan Addams

Hi

I have utilised Duane Hookom's gantt chart report from
http://www.access.hookom.net/Samples/CalendarReports.zip

Then I decided rather than to view it as a year, to view it as a
month, and I was wondering if there was a way to get access to show a
grid for dates on it? the current code is:

Option Compare Database
Option Explicit

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim lngDuration As Long 'days of tour
Dim lngStart As Long 'start date of tour
Dim lngLMarg As Long
Dim dblFactor As Double
Dim X As Double
'put a line control in your page header that starts 1/1 and goes
to 12/31
lngLMarg = Me.boxTimeLine.Left
dblFactor = Me.boxTimeLine.Width / 31
lngStart = DateDiff("d", Me.Monthname, Me.[Start Date])
lngDuration = DateDiff("d", Me.[Start Date], Me.[End Date])
'set the color of the bar based on a data value
Me.txtName.BackColor = Me.TaskColour
Me.txtName.Width = 10 'avoid the positioning error
Me.txtName.Left = (lngStart * dblFactor) + lngLMarg
Me.txtName.Width = (lngDuration * dblFactor)
Me.MoveLayout = False
End Sub

Private Sub Report_Close()
DoCmd.Restore
End Sub

Private Sub Report_Open(Cancel As Integer)
DoCmd.Maximize
End Sub


Any help would be appreciated.
 
Why not just use the Line control? You could place 31 vertical lines in the
group footer or detail section (I think).

You could also use the Line method of the report to draw vertical lines. It
would require setting up a loop from 0 to 31 and multiplying the loop number
times dblFactor and adding lngLMarg to get the X value of the line. The
problem with the line method is that it would draw on top of the boxes if
they cross dates. This could be resolved by creating a group header that is
the same height as the detail and footer section. Then use code like:
Private Sub GroupHeader0_Print(Cancel As Integer, PrintCount As Integer)
Dim lngLMarg As Long
Dim dblFactor As Double
Dim intDay As Integer
Dim dblLeft As Double
'put a line control in your page header that starts 1/1 and goes to 12/31
lngLMarg = Me.boxTimeLine.Left
dblFactor = Me.boxTimeLine.Width / 31
For intDay = 0 To 31
dblLeft = intDay * dblFactor + lngLMarg
Me.Line (dblLeft, 0)-Step(0, Me.Height)
Next
Me.MoveLayout = False
End Sub
 
Thankyou very much, you have been an incredible help.

Why not just use the Line control? You could place 31 vertical lines in the
group footer or detail section (I think).

You could also use the Line method of the report to draw vertical lines. It
would require setting up a loop from 0 to 31 and multiplying the loop number
times dblFactor and adding lngLMarg to get the X value of the line. The
problem with the line method is that it would draw on top of the boxes if
they cross dates. This could be resolved by creating a group header that is
the same height as the detail and footer section. Then use code like:
Private Sub GroupHeader0_Print(Cancel As Integer, PrintCount As Integer)
    Dim lngLMarg As Long
    Dim dblFactor As Double
    Dim intDay As Integer
    Dim dblLeft As Double
    'put a line control in your page header that starts 1/1 and goes to 12/31
    lngLMarg = Me.boxTimeLine.Left
    dblFactor = Me.boxTimeLine.Width / 31
    For intDay = 0 To 31
        dblLeft = intDay * dblFactor + lngLMarg
        Me.Line (dblLeft, 0)-Step(0, Me.Height)
    Next
    Me.MoveLayout = False
End Sub

--
Duane Hookom
Microsoft Access MVP

Ryan Addams said:
I have utilised Duane Hookom's gantt chart report from
http://www.access.hookom.net/Samples/CalendarReports.zip
Then I decided rather than to view it as a year, to view it as a
month, and I was wondering if there was a way to get access to show a
grid for dates on it? the current code is:
Option Compare Database
Option Explicit
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
    Dim lngDuration As Long 'days of tour
    Dim lngStart As Long  'start date of tour
    Dim lngLMarg As Long
    Dim dblFactor As Double
    Dim X As Double
    'put a line control in your page header that starts 1/1 and goes
to 12/31
    lngLMarg = Me.boxTimeLine.Left
    dblFactor = Me.boxTimeLine.Width / 31
    lngStart = DateDiff("d", Me.Monthname, Me.[Start Date])
    lngDuration = DateDiff("d", Me.[Start Date], Me.[End Date])
    'set the color of the bar based on a data value
    Me.txtName.BackColor = Me.TaskColour
    Me.txtName.Width = 10  'avoid the positioning error
    Me.txtName.Left = (lngStart * dblFactor) + lngLMarg
    Me.txtName.Width = (lngDuration * dblFactor)
    Me.MoveLayout = False
End Sub
Private Sub Report_Close()
    DoCmd.Restore
End Sub
Private Sub Report_Open(Cancel As Integer)
    DoCmd.Maximize
End Sub
Any help would be appreciated.
.
 
I wanted to run mine for 28 days. I tried just having the code divide by 28 and put 28 boxes inside the control box as suggested. However, the bars just weren't lining with the daily boxes. I ended up drawing the bars based on the .Left setting of the box I wanted the bar to start under and extending it to the right side of the last bar in the grouping. Also, I had jobs with no crew assigned to them just yet, so I had to account for that...


Dim lngDuration As Long 'days of tour
Dim lngStart As Long 'start date of tour
Dim txtStart 'bar start position
If IsNull([Start Date]) = False Then 'Don't want to draw boxes if no records exists for a grouping
lngStart = DateDiff("d", Me.[ReportDate], Me.[Start Date]) 'Determine bar start position
lngDuration = DateDiff("d", Me.[Start Date], Me.[End Date]) + 1 'Add one to extend the width to the right side of the end box
txtStart = "txtMth" & lngStart 'Name of the start box ie: txtMth4
lngStart = Me(txtStart).Left 'Start the bar at the Left position of the start box
lngDuration = (Me.txtMth0.Width * lngDuration) 'Draw the bar to the right side of the end box
Else
lngStart = -1
lngDuration = -1
End If
Me.EmpName.ForeColor = Me.VesselColor 'set the color of the record identifier
If lngStart >= 0 Then
Me.txtName.BackColor = Me.VesselColor 'set the color of the bar
Me.txtName.Width = 10 'avoid the positioning error
Me.txtName.Left = lngStart 'set bar start position
Me.txtName.Width = lngDuration 'set bar end position
Else
Me.txtName.BackColor = 0 'no data requires no bar color
Me.txtName.Width = 10 'avoid the positioning error
Me.txtName.Left = 0 'start the empty bar at 0
Me.txtName.Width = 0 'end the empty bar at 0
End If
 
Back
Top