Do you know something I don't? Because how would you wrap controls that would extend past your date on the right in a continuous form? Here is the code I created today wrapping controls and sizing them with vba.
Option Compare Database
Function LenMonth() As Long
Dim Dstart As Date, Dfinish As Date, dayOne As Date
dayOne = Format(DateValue(Format(Now, "m") & "/1/" & Format(Now, "yyyy")), "mm/dd/yyyy")
Dstart = DateValue(Month(dayOne) & "/1/" & Year(dayOne))
Dfinish = DateAdd("m", 1, Dstart)
LenMonth = Dfinish - Dstart
End Function
Function NextMonthDays(lngTotalDays As Long) As String
Dim Dstart As Date, Dfinish As Date, dayOne As Date
dayOne = Format(DateValue(Format(Now, "m") & "/1/" & Format(Now, "yyyy")), "mm/dd/yyyy")
Dstart = DateValue(Month(dayOne) & "/1/" & Year(dayOne))
NextMonthDays = Format(DateAdd("d", lngTotalDays - 1, Dstart), "d")
If NextMonthDays = "1" Then
NextMonthDays = Format(DateAdd("d", lngTotalDays - 1, Dstart), "mmm") & " 1"
End If
End Function
Function BuildEvents()
Dim RStblPersonnel_Events As DAO.Recordset, lngEvents As Long, ctrlCurrent As Label, ctrlCheck As Label, Dstart As Date, Dend As Date, lngEventChecker As Long, lngModifiedTop As Long
Dim ctrlExpand As Label, ctrlExpand2 As Label, lngRightBlock As Long, lngLengthofControl As Long, lngRemainingLength As Long, bControlAvailable As Boolean, i As Long
Dim lngNumberOfControlsUsed As Long
Set db = CurrentDb
Set RStblPersonnel_Events = db.OpenRecordset("select * From [tblPersonnel Events] Order By [End Event] DESC")
RStblPersonnel_Events.MoveLast
RStblPersonnel_Events.MoveFirst
lngEvents = RStblPersonnel_Events.RecordCount
lngNumberOfControlsUsed = lngEvents
Do While RStblPersonnel_Events.EOF = False
lngEventChecker = RStblPersonnel_Events.RecordCount
Set ctrlCurrent = Forms![frmcalendarnew].Controls("lblEvent" & lngEvents)
With ctrlCurrent
'// Setting the Caption of the Event Label
.Caption = RStblPersonnel_Events("Personnel Number") & " - " & RStblPersonnel_Events("Event") & " - " & RStblPersonnel_Events("Start Event") & "-" & RStblPersonnel_Events("End Event")
'// Getting Event Dates
Dstart = RStblPersonnel_Events("Start Event")
Dend = RStblPersonnel_Events("End Event")
'// Finding where to put the top of the Event Label
If lngEvents = RStblPersonnel_Events.RecordCount Then
.Top = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top
Else
Do While lngEventChecker <> lngEvents
Set ctrlCheck = Forms![frmcalendarnew].Controls("lblEvent" & lngEventChecker)
With ctrlCheck
If .Top = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top Then
If .Left = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Left Then
lngModifiedTop = .Top + .Height
Else
lngModifiedTop = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Top
End If
Else
If .Left = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Left Then
lngModifiedTop = lngModifiedTop + .Height
Else
lngModifiedTop = lngModifiedTop
End If
End If
End With
Set ctrlCheck = Nothing
lngEventChecker = lngEventChecker - 1
Loop
.Top = lngModifiedTop
lngModifiedTop = 0
End If
'// Setting the Left of the Event Label
.Left = Forms![frmcalendarnew].Controls("lbl" & Format(Dstart, "d")).Left
'// Get the length to the end of the row date
If Format(Dstart, "d") > 7 Then
If Format(Dstart, "d") > 14 Then
If Format(Dstart, "d") > 21 Then
If Format(Dstart, "d") > 28 Then
lngRightBlock = Forms![frmcalendarnew].Controls("B" & LenMonth).Left + Forms![frmcalendarnew].Controls("B" & LenMonth).Width
Else
lngRightBlock = Forms![frmcalendarnew].Controls("B28").Left + Forms![frmcalendarnew].Controls("B28").Width
End If
Else
lngRightBlock = Forms![frmcalendarnew].Controls("B21").Left + Forms![frmcalendarnew].Controls("B21").Width
End If
Else
lngRightBlock = Forms![frmcalendarnew].Controls("B14").Left + Forms![frmcalendarnew].Controls("B14").Width
End If
Else
lngRightBlock = Forms![frmcalendarnew].Controls("B7").Left + Forms![frmcalendarnew].Controls("B7").Width
End If
'// Now use the right block data to see if control will extend over and set the correct width
lngLengthofControl = DateDiff("d", Dstart, Dend) * Forms![frmcalendarnew].Controls("B1").Width
If .Left + lngLengthofControl > lngRightBlock Then
lngRemainingLength = (.Left + lngLengthofControl) - lngRightBlock
.Width = lngLengthofControl - lngRemainingLength + 200
Else
.Width = Forms![frmcalendarnew].Controls("B" & Format(Dstart, "d")).Width * DateDiff("d", Dstart, Dend)
End If
'// Sets the height of Event Label
.Height = Forms![frmcalendarnew].Controls("lbl" & Format(Dstart, "d")).Height
'// Makes the Event Label Visable
.Visible = True
End With
'// Clears the control
Set ctrlCurrent = Nothing
'// If remaining Length is present then start another control to lap over
If lngRemainingLength > 0 Then
'// Find a control that is Available
lngNumberOfControlsUsed = lngNumberOfControlsUsed + 1
'// This takes a control available outside of the reserved ones
Set ctrlExpand = Forms![frmcalendarnew].Controls("lblevent" & lngNumberOfControlsUsed)
'// Now start setting and checking Event Labels
With ctrlExpand
.Caption = RStblPersonnel_Events("Personnel Number") & " - " & RStblPersonnel_Events("Event") & " - " & RStblPersonnel_Events("Start Event") & "-" & RStblPersonnel_Events("End Event")
End With
Set ctrlExpand = Nothing
End If
lngEvents = lngEvents - 1
RStblPersonnel_Events.MoveNext
Loop
End Function
Its not done yet obviously but its working good so far with a few events I put in a table.
TheChazm