Scott said:
I need to write a program.
the basic format is a calendar. 1 month.
They click on the day and enter text.
The Calendar needs to be the size of the screen.
Scott, we developed one that works with a grid control. If you know how ot
use a Grid control then the following code may help you with the step we took.
The thing that we like about the grid contorl was that you can select
multiple days that dont have to be in a row or column ( you can actually
select complete random days)
Hope this helps
Module declaration
Private WithEvents AX As axExplorerBar
Public WithEvents iCal As iGrid
Public WithEvents iDay As iGrid
Private WithEvents DatePick As DTPicker
Private CalDateRow As Long
Private CalDateCol As Long
Private SelectedCalDateRow As Long
Private SelectedCalDateCol As Long
Private BeginDate As Date
Private EndDate As Date
Private TodayDate As Date
Private ScaleSetting As Long
Private SetDates As Collection
Private OldSetDates As Collection
Private SetTimes As Collection
Private SelectedDays As Collection
Private firstday As Date
Private FirstDayWeekday As Long
Private LastDay As Date
Private BeginCal As Date
Private whodunnit As Long
Private Em_ID As Long
Private cmb As CommandBar
Private ID As Long
Private StartDate As Date
Private EndTime As Date
Private Sub SetMonthCalGrid(sDay As Date, Optional CalReset As Boolean = True)
Dim x As Long
Dim y As Long
Dim weekcount As Long
Dim sRow As Long
Dim sWeek As Long
Dim CurCol As Long
Dim Appnts As Long
Dim CellValue As String
Dim BckClr As Long
Dim FntClr As Long
On Error GoTo HandleErr
If CalReset Then
For x = OldSetDates.Count To 1 Step -1
OldSetDates.Remove (x)
Next x
For x = 1 To SetDates.Count
Debug.Print "SetDate Value " & x & " - " & SetDates.Item(x)
OldSetDates.Add SetDates.Item(x)
Next x
End If
Me.iCal.Clear True
With Me.iCal
.DefaultRowHeight = 25
.Header.BackColor = 13292476
.Header.ForeColor = 0
.Header.Flat = True
'.Header.HotTrackForeColor =
.BackColor = 15988207
.BackColorEvenRows = 13887458
.BackColorOddRows = 13558751 '14147020
.FocusRectColor1 = vbRed
.FocusRectColor2 = vbRed
.HighlightForeColor = 0
.HighlightBackColor = 14540287 '13292476
.HighlightForeColorNoFocus = 0
.HighlightBackColorNoFocus = 13292476
.GridlineColor = 13292476
.GridLines = igGridLinesBoth
.Enabled = True
.Editable = False
.MultiSelect = True
End With
For x = 1 To 7
With Me.iCal
.AddCol x, Format(x, "ddd")
.ColMinWidth(x) = 37
.ColMaxWidth(x) = 37 * frmResize.ScaleFactorX
End With
Next x
firstday = FirstDayOfMonthGiven(sDay) 'custom function
FirstDayWeekday = WeekDay(firstday)
LastDay = LastDayOfLastMonthGiven(sDay)'custom function
BeginCal = DateAdd("d", 1 - WeekDay(LastDay), LastDay)
For x = 1 To 6
With Me.iCal
.AddRow x
End With
Next x
x = 0
For sWeek = 1 To 6
For CurCol = 1 To 7
sRow = 1 + ((sWeek - 1))
With Me.iCal
Appnts = SetAppointmentsPerDay(DateAdd("d", x, BeginCal), Em_ID)
'this is a call to a function that returns the number of appointments on that
day.
If Appnts = 0 Then
CellValue = Format(DateAdd("d", x, BeginCal), "d")
FntClr = 0
Else
CellValue = Format(DateAdd("d", x, BeginCal), "d") & " / " &
Appnts
FntClr = RGB(255, 0, 0)
End If
SetCellValue Me.iCal, CellValue, sRow, CurCol, False, False,
False, 25, , , FntClr
If DateValue(DateAdd("d", x, BeginCal)) = DateValue(TodayDate)
Then
.CellBackColor(sRow, CurCol) = vbBlack
.CellForeColor(sRow, CurCol) = vbWhite
CalDateRow = sRow
CalDateCol = CurCol
End If
If DateValue(DateAdd("d", x, BeginCal)) = DateValue(sDay) Then
SelectedCalDateRow = sRow
SelectedCalDateCol = CurCol
End If
If CalReset Then
For y = 1 To OldSetDates.Count
If DateValue(CDate(OldSetDates.Item(y))) = DateValue
(DateAdd("d", x, BeginCal)) Then
Me.iCal.CellSelected(sRow, CurCol) = True
End If
Next y
End If
End With
sRow = sRow + 1
x = x + 1
Next CurCol
Next sWeek
If CalReset Then
For x = SetDates.Count To 1 Step -1
SetDates.Remove (x)
Next x
For x = 1 To OldSetDates.Count
SetDates.Add OldSetDates.Item(x)
Next x
End If
exithere:
Exit Sub
HandleErr:
GoTo exithere 'we have a custom error handler
End Sub
Some of the stuff is turner things color based on data and stuff, but did not
want to erase so you could just read through the code and get an idea what we
did.
