Advertisement
Temporary4Now

CalendarVBA

Aug 21st, 2023 (edited)
1,156
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VB.NET 88.21 KB | None | 0 0
  1.  
  2. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  3. ' Global Variables
  4. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  5. Option Explicit
  6.  
  7. 'These two Enums are used in the GetDate function for the user to select the start day
  8. 'of the week, and the behavior of the week numbers. These are used in place of the
  9. 'Excel constants vbDayOfWeek and vbFirstWeekOfYear in order to avoid dealing with
  10. 'system time, which is an option in both of those. Otherwise the values are identical.
  11. Public Enum calDayOfWeek
  12.     Sunday = 1
  13.     Monday = 2
  14.     Tuesday = 3
  15.     Wednesday = 4
  16.     Thursday = 5
  17.     Friday = 6
  18.     Saturday = 7
  19. End Enum
  20.  
  21. Public Enum calFirstWeekOfYear      'Controls how the week numbers are calculated and displayed
  22.     FirstJan1 = 1                   'The week with January 1st is always counted as week 1
  23.     FirstFourDays = 2               'The first week in January that has at least four days in it is
  24.                                         'counted as week 1. This calculation will change depending
  25.                                         'on the setting used for first day of the week. The ISO
  26.                                         'standard is calculating week 1 as the first week in January
  27.                                         'with four days with Monday being the first day of the week.
  28.     FirstFullWeek = 3               'The first week in January with a full week is counted as week 1.
  29.                                         'Like the FirstFourDays setting, this calculation will change
  30.                                         'depending on the first day of the week used.
  31. End Enum
  32.  
  33. Private UserformEventsEnabled As Boolean    'Controls userform events
  34. Private DateOut As Date                     'The date returned from the CalendarForm
  35. Private SelectedDateIn As Date              'The initial selected date, as well as the date currently selected by the
  36.                                                 'user if the Okay button is enabled
  37. Private OkayEnabled As Boolean              'Stores whether Okay button is enabled
  38. Private TodayEnabled As Boolean             'Stores whether Today button is enabled
  39. Private MinDate As Date                     'Minimum date set by user
  40. Private MaxDate As Date                     'Maximum date set by user
  41. Private cmbYearMin As Long                  'Current lower bounds of year combobox. Not necessarily restricted to this min
  42. Private cmbYearMax As Long                  'Current upper bounds of year combobox. Not necessarily restricted to this max
  43. Private StartWeek As VbDayOfWeek            'First day of week in calendar
  44. Private WeekOneOfYear As VbFirstWeekOfYear  'First week of year when setting week numbers
  45. Private HoverControlName As String          'Name of the date label that is currently being hovered over. Used when returning
  46.                                                 'the hovered control to its original color
  47. Private HoverControlColor As Long           'Original color of the date label that is currently being hovered over
  48. Private RatioToResize As Double             'Ratio to resize elements of userform. This is set by the DateFontSize argument
  49.                                                 'in the GetDate function
  50. Private bgDateColor As Long                 'Color of date label backgrounds
  51. Private bgDateHoverColor As Long            'Color of date label backgrounds when hovering over
  52. Private bgDateSelectedColor As Long         'Color of selected date label background
  53. Private lblDateColor As Long                'Font color of date labels
  54. Private lblDatePrevMonthColor As Long       'Font color of trailing month date labels
  55. Private lblDateTodayColor As Long           'Font color of today's date
  56. Private lblDateSatColor As Long             'Font color of Saturday date labels
  57. Private lblDateSunColor As Long             'Font color of Sunday date labels
  58.  
  59.  
  60. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  61. ' GetDate
  62. '
  63. ' This function is the point of entry into the CalendarForm. It controls EVERYTHING.
  64. ' Every argument is optional, meaning your function call can be as simple as:
  65. '
  66. '   MyDateVariable = CalendarForm.GetDate
  67. '
  68. ' That's all there is to it. The calendar initializes, pops up, the user selects a date,
  69. ' the selection is received by your variable, and the calendar unloads.
  70. '
  71. ' From there, you can use as many or as few arguments as you want in order to get the
  72. ' desired calendar that suits your needs. All default values are also set in this
  73. ' function, so if you want to change default colors or behavior without having to
  74. ' explicitly do so in every function call, you can set those in the argument list
  75. ' here.
  76. '
  77. ' Below is a list of all arguments, their data type, and their function:
  78. '   SelectedDate (Date) - This is the initial selected date on the calendar. Used to
  79. '       show the users last selection. If this value is set, the calendar will
  80. '       initialize to the month and year of the SelectedDate. If not, it will
  81. '       initialize to today's date (with no selection).
  82. '   FirstDayOfWeek (calDayOfWeek) - Sets which day to use as first day of the week.
  83. '   MinimumDate (Date) - Restricts the selection of any dates below this date.
  84. '   MaximumDate (Date) - Restricts the selection of any dates above this date.
  85. '   RangeOfYears (Long) - Sets the range of years to show in the year combobox in
  86. '       either direction from the initial SelectedDate. For example, if the
  87. '       SelectedDate is in 2014, and the RangeOfYears is set to 10 (the default value),
  88. '       the year combobox will show 10 years below 2014 to 10 years above 2014, so it
  89. '       will have a range of 2004-2024. Note that if this range falls outside the bounds
  90. '       set by the MinimumDate or MaximumDate, it will be overridden. Also, this
  91. '       range does NOT limit the years that a user can select. If the upper limit of
  92. '       the year combobox is 2024, and the user clicks the month spinner to surpass
  93. '       December 2024, it will keep right on going to 2025 and beyond (and those
  94. '       years will be added to the year combobox).
  95. '   DateFontSize (Long) - Controls the size of the CalendarForm. This value cannot
  96. '       be set below 9 (the default). To make the form bigger, set this value larger,
  97. '       and everything else in the userform will be resized to fit.
  98. '   TodayButton (Boolean) - Controls whether or not the Today button is visible.
  99. '   OkayButton (Boolean) - Controls whether or not the Okay button is visible. If the
  100. '       Okay button is enabled, when the user selects a date, it is highlighted, but
  101. '       is not returned until they click Okay. If the Okay button is disabled,
  102. '       clicking a date will automatically return that date and unload the form.
  103. '   ShowWeekNumbers (Boolean) - Controls the visibility of the week numbers.
  104. '   FirstWeekOfYear (calFirstWeekOfYear) - Sets the behavior of the week numbers. See
  105. '       the calFirstWeekOfYear Enum in the Global Variables section to see the possible
  106. '       values and their behavior.
  107. '   PositionTop (Long) - Sets the top position of the CalendarForm. If no value is
  108. '       assigned, the CalendarForm is set to position 1 - CenterOwner. Note that
  109. '       PositionTop and PositionLeft must BOTH be set in order to override the default
  110. '       center position.
  111. '   PositionLeft (Long) - Sets the left position of the CalendarForm. If no value is
  112. '       assigned, the CalendarForm is set to position 1 - CenterOwner. Note that
  113. '       PositionTop and PositionLeft must BOTH be set in order to override the default
  114. '       center position.
  115. '   BackgroundColor (Long) - Sets the background color of the CalendarForm.
  116. '   HeaderColor (Long) - Sets the background color of the header. The header is the
  117. '       month and year label at the top.
  118. '   HeaderFontColor (Long) - Sets the color of the header font.
  119. '   SubHeaderColor (Long) - Sets the background color of the subheader. The subheader
  120. '       is the day of week labels under the header (Su, Mo, Tu, etc).
  121. '   SubHeaderFontColor (Long) - Sets the color of the subheader font.
  122. '   DateColor (Long) - Sets the background color of the individual date labels.
  123. '   DateFontColor (Long) - Sets the font color of the individual date labels.
  124. '   SaturdayFontColor (Long) - Sets the font color of Saturday date labels.
  125. '   SundayFontColor (Long) - Sets the font color of Sunday date labels.
  126. '   DateBorder (Boolean) - Controls whether or not the date labels have borders.
  127. '   DateBorderColor (Long) - Sets the color of the date label borders. Note that the
  128. '       argument DateBorder must be set to True for this setting to take effect.
  129. '   DateSpecialEffect (fmSpecialEffect) - Sets a special effect for the date labels.
  130. '       This can be set to bump, etched, flat (default value), raised, or sunken.
  131. '       This can be used to make the date labels look like buttons if you desire.
  132. '       Note that this setting overrides any date border settings you have made.
  133. '   DateHoverColor (Long) - Sets the background color when hovering the mouse over
  134. '       a date label.
  135. '   DateSelectedColor (Long) - Sets the background color of the selected date.
  136. '   TrailingMonthFontColor (Long) - Sets the color of the date labels in trailing
  137. '       months. Trailing months are the date labels from last month at the top of the
  138. '       calendar and from next month at the bottom of the calendar.
  139. '   TodayFontColor (Long) - Sets the font color of today's date.
  140. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  141. Public Function GetDate(Optional SelectedDate As Date = 0, _
  142.     Optional FirstDayOfWeek As calDayOfWeek = Sunday, _
  143.     Optional MinimumDate As Date = 0, _
  144.     Optional MaximumDate As Date = 0, _
  145.     Optional RangeOfYears As Long = 10, _
  146.     Optional DateFontSize As Long = 9, _
  147.     Optional TodayButton As Boolean = False, Optional OkayButton As Boolean = False, _
  148.     Optional ShowWeekNumbers As Boolean = False, Optional FirstWeekOfYear As calFirstWeekOfYear = FirstJan1, _
  149.     Optional PositionTop As Long = -5, Optional PositionLeft As Long = -5, _
  150.     Optional BackgroundColor As Long = 16777215, _
  151.     Optional HeaderColor As Long = 15658734, _
  152.     Optional HeaderFontColor As Long = 0, _
  153.     Optional SubHeaderColor As Long = 16448250, _
  154.     Optional SubHeaderFontColor As Long = 8553090, _
  155.     Optional DateColor As Long = 16777215, _
  156.     Optional DateFontColor As Long = 0, _
  157.     Optional SaturdayFontColor As Long = 0, _
  158.     Optional SundayFontColor As Long = 0, _
  159.     Optional DateBorder As Boolean = False, Optional DateBorderColor As Long = 15658734, _
  160.     Optional DateSpecialEffect As fmSpecialEffect = fmSpecialEffectFlat, _
  161.     Optional DateHoverColor As Long = 15658734, _
  162.     Optional DateSelectedColor As Long = 14277081, _
  163.     Optional TrailingMonthFontColor As Long = 12566463, _
  164.     Optional TodayFontColor As Long = 15773696) As Date
  165.    
  166.     'Set global variables
  167.     DateFontSize = Max(DateFontSize, 9) 'Font size cannot be below 9
  168.     OkayEnabled = OkayButton
  169.     TodayEnabled = TodayButton
  170.     RatioToResize = DateFontSize / 9
  171.     bgDateColor = DateColor
  172.     lblDateColor = DateFontColor
  173.     lblDateSatColor = SaturdayFontColor
  174.     lblDateSunColor = SundayFontColor
  175.     bgDateHoverColor = DateHoverColor
  176.     bgDateSelectedColor = DateSelectedColor
  177.     lblDatePrevMonthColor = TrailingMonthFontColor
  178.     lblDateTodayColor = TodayFontColor
  179.     StartWeek = FirstDayOfWeek
  180.     WeekOneOfYear = FirstWeekOfYear
  181.    
  182.     'Initialize userform
  183.     UserformEventsEnabled = False
  184.     Call InitializeUserform(SelectedDate, MinimumDate, MaximumDate, RangeOfYears, PositionTop, PositionLeft, _
  185.         DateFontSize, ShowWeekNumbers, BackgroundColor, HeaderColor, HeaderFontColor, SubHeaderColor, _
  186.         SubHeaderFontColor, DateBorder, DateBorderColor, DateSpecialEffect)
  187.     UserformEventsEnabled = True
  188.    
  189.     'Show userform, return selected date, and unload
  190.     Me.Show
  191.     GetDate = DateOut
  192.     Unload Me
  193. End Function
  194.  
  195.  
  196.  
  197. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  198. ' InitializeUserform
  199. '
  200. ' This sub initializes the size and positions of every element on the userform.
  201. ' Everything is sized based on the RatioToResize variable. RatioToResize is calculated
  202. ' based on the ratio of the font size passed to the GetDate function to the default
  203. ' font size.
  204. '
  205. ' The visibility of the Okay button, Today button, and week numbers is also set here.
  206. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  207. Private Sub InitializeUserform(SelectedDate As Date, MinimumDate As Date, MaximumDate As Date, _
  208.     RangeOfYears As Long, _
  209.     PositionTop As Long, PositionLeft As Long, _
  210.     SizeFont As Long, bWeekNumbers As Boolean, _
  211.     BackgroundColor As Long, _
  212.     HeaderColor As Long, _
  213.     HeaderFontColor As Long, _
  214.     SubHeaderColor As Long, _
  215.     SubHeaderFontColor As Long, _
  216.     DateBorder As Boolean, DateBorderColor As Long, _
  217.     DateSpecialEffect As fmSpecialEffect)
  218.    
  219.     Dim TempDate As Date                        'Used to set selected date, if none has been provided
  220.     Dim SelectedYear As Long                    'Year of selected date
  221.     Dim SelectedMonth As Long                   'Month of selected date
  222.     Dim SelectedDay As Long                     'Day of seledcted date (if applicable)
  223.     Dim TempDayOfWeek As Long                   'Used to set day labels in subheader
  224.     Dim BorderSpacing As Double                 'Padding between the outermost elements of userform and edge of userform
  225.     Dim HeaderDefaultFontSize As Long           'Default font size of the header labels (month and year)
  226.     Dim bgHeaderDefaultHeight As Double         'Default height of the background behind header labels
  227.     Dim lblMonthYearDefaultHeight As Double     'Default height of the month and year header labels
  228.     Dim scrlMonthDefaultHeight As Double        'Default height of the month scroll bar
  229.     Dim bgDayLabelsDefaultHeight As Double      'Default height of the background behind the subheader day of week labels
  230.     Dim bgDateDefaultHeight As Double           'Default height of the background behind each date label
  231.     Dim bgDateDefaultWidth As Double            'Default width of the background behind each date label
  232.     Dim lblDateDefaultHeight As Double          'Default height of each date label
  233.     Dim cmdButtonDefaultHeight As Double        'Default height of Today and Okay command buttons
  234.     Dim cmdButtonDefaultWidth As Double         'Default width of Today and Okay command buttons
  235.     Dim cmdButtonsCombinedWidth As Double       'Combined width of Today and Okay buttons. Used to center on userform
  236.     Dim cmdButtonsMaxHeight As Double           'Maximum height of command buttons and month scroll bar
  237.     Dim cmdButtonsMaxWidth As Double            'Maximum width of command buttons
  238.     Dim cmdButtonsMaxFontSize As Long           'Maximum font size of command buttons
  239.     Dim bgControl As MSForms.Control            'Stores current date label background in loop to initialize various settings
  240.     Dim lblControl As MSForms.Control           'Stores current date label in loop to initialize various settings
  241.     Dim HeightOffset As Double                  'Difference between form height and inside height, to account for toolbar
  242.     Dim i As Long                               'Used for loops
  243.     Dim j As Long                               'Used for loops
  244.    
  245.     'Initialize default values
  246.     BorderSpacing = 6 * RatioToResize
  247.     HeaderDefaultFontSize = 11
  248.     bgHeaderDefaultHeight = 30
  249.     lblMonthYearDefaultHeight = 13.5
  250.     scrlMonthDefaultHeight = 18
  251.     bgDayLabelsDefaultHeight = 18
  252.     bgDateDefaultHeight = 18
  253.     bgDateDefaultWidth = 18
  254.     lblDateDefaultHeight = 10.5
  255.     cmdButtonDefaultHeight = 24
  256.     cmdButtonDefaultWidth = 60
  257.     cmdButtonsMaxHeight = 36
  258.     cmdButtonsMaxWidth = 90
  259.     cmdButtonsMaxFontSize = 14
  260.  
  261.    
  262.     'Set MinDate and MaxDate. If no MinimumDate or MaximumDate are provided, set the
  263.     'MinDate to 1/1/1900 and the MaxDate to 12/31/9999. If MaxDate is less than
  264.     'MinDate, it will default to the MinDate.
  265.     If MinimumDate <= 0 Then
  266.         MinDate = CDate("1/1/1900")
  267.     Else
  268.         MinDate = MinimumDate
  269.     End If
  270.     If MaximumDate = 0 Then
  271.         MaxDate = CDate("12/31/9999")
  272.     Else
  273.         MaxDate = MaximumDate
  274.     End If
  275.     If MaxDate < MinDate Then MaxDate = MinDate
  276.    
  277.     'If today's date falls outside min/max, make sure Today button is disabled
  278.     If Date < MinDate Or Date > MaxDate Then TodayEnabled = False
  279.  
  280.     'Initialize userform position. Initial value of top and left is -5. Check
  281.     'this value to see if a different value has been passed. If not, position
  282.     'to CenterOwner. Must set both top and left positions to override center position
  283.     If PositionTop <> -5 And PositionLeft <> -5 Then
  284.         Me.StartUpPosition = 0
  285.         Me.Top = PositionTop
  286.         Me.Left = PositionLeft
  287.     Else
  288.         Me.StartUpPosition = 1
  289.     End If
  290.    
  291.     'Size header elements - header background, month scroll bar, scroll cover (which is just
  292.     'a blank label which sits on top of the month scroll bar to make it look like two spin
  293.     'buttons), month/year labels in header, and the month and year comboboxes
  294.     With bgHeader
  295.         .Height = bgHeaderDefaultHeight * RatioToResize
  296.         'The header width depends on whether week numbers are visible or not
  297.         If bWeekNumbers Then
  298.             .Width = 8 * (bgDateDefaultWidth * RatioToResize) + BorderSpacing
  299.         Else
  300.             .Width = 7 * (bgDateDefaultWidth * RatioToResize)
  301.         End If
  302.         .Left = BorderSpacing
  303.         .Top = BorderSpacing
  304.     End With
  305.     'Month scroll bar. I set a maximum height for the scroll bar, because as it gets
  306.     'larger, the width of the scroll buttons never increases, so eventually it ends
  307.     'up looking really tall and skinny and weird.
  308.     With scrlMonth
  309.         .Width = bgHeader.Width - (2 * BorderSpacing)
  310.         .Left = bgHeader.Left + BorderSpacing
  311.         .Height = scrlMonthDefaultHeight * RatioToResize
  312.         If .Height > cmdButtonsMaxHeight Then .Height = cmdButtonsMaxHeight
  313.         .Top = bgHeader.Top + ((bgHeader.Height - .Height) / 2)
  314.     End With
  315.     'Cover over month scroll bar
  316.     With bgScrollCover
  317.         .Height = scrlMonth.Height
  318.         .Width = scrlMonth.Width - 25 '25 is the width of the actual scroll buttons,
  319.                                       'which need to remain visible
  320.         .Left = scrlMonth.Left + 12.5
  321.         .Top = scrlMonth.Top
  322.     End With
  323.     'The .left position of the month and year labels in the header will be set
  324.     'in the function SetMonthYear, as it changes based on the selected month/year.
  325.     'So only the top needs to be positioned now
  326.     With lblMonth
  327.         .AutoSize = False
  328.         .Height = lblMonthYearDefaultHeight * RatioToResize
  329.         .Font.Size = HeaderDefaultFontSize * RatioToResize
  330.         .Top = bgScrollCover.Top + ((bgScrollCover.Height - .Height) / 2)
  331.     End With
  332.     With lblYear
  333.         .AutoSize = False
  334.         .Height = lblMonthYearDefaultHeight * RatioToResize
  335.         .Font.Size = HeaderDefaultFontSize * RatioToResize
  336.         .Top = bgScrollCover.Top + ((bgScrollCover.Height - .Height) / 2)
  337.     End With
  338.     cmbMonth.Top = lblMonth.Top + (lblMonth.Height - cmbMonth.Height)
  339.     cmbYear.Top = lblYear.Top + (lblYear.Height - cmbYear.Height)
  340.  
  341.     'Size subheader elements - the subheader bacgkround (bgDayLabels), the day of
  342.     'week labels themselves, and the week number subheader label, if applicable
  343.     With bgDayLabels
  344.         .Height = bgDayLabelsDefaultHeight * RatioToResize
  345.         'The width depends on whether week numbers are visible or not
  346.         If bWeekNumbers Then
  347.             .Width = 8 * (bgDateDefaultWidth * RatioToResize) + BorderSpacing
  348.         Else
  349.             .Width = 7 * (bgDateDefaultWidth * RatioToResize)
  350.         End If
  351.         .Left = BorderSpacing
  352.         .Top = bgHeader.Top + bgHeader.Height
  353.     End With
  354.     'Week number subheader label
  355.     If Not bWeekNumbers Then
  356.         lblWk.Visible = False
  357.     Else
  358.         With lblWk
  359.             .AutoSize = False
  360.             .Height = lblDateDefaultHeight * RatioToResize
  361.             .Font.Size = SizeFont
  362.             .Width = bgDateDefaultWidth * RatioToResize
  363.             .Top = bgDayLabels.Top + ((bgDayLabels.Height - .Height) / 2)
  364.             .Left = BorderSpacing
  365.         End With
  366.     End If
  367.     'Day of week subheader labels
  368.     For i = 1 To 7
  369.         With Me("lblDay" & CStr(i))
  370.             .AutoSize = False
  371.             .Height = lblDateDefaultHeight * RatioToResize
  372.             .Font.Size = SizeFont
  373.             .Width = bgDateDefaultWidth * RatioToResize
  374.             .Top = bgDayLabels.Top + ((bgDayLabels.Height - .Height) / 2)
  375.             If i = 1 Then
  376.                 'Left position of first label depends on whether week numbers are visible
  377.                 If bWeekNumbers Then
  378.                     .Left = lblWk.Left + lblWk.Width + BorderSpacing
  379.                 Else
  380.                     .Left = BorderSpacing
  381.                 End If
  382.             Else 'All other labels placed directly next to preceding label
  383.                 .Left = Me("lblDay" & CStr(i - 1)).Left + Me("lblDay" & CStr(i - 1)).Width
  384.             End If
  385.         End With
  386.     Next i
  387.    
  388.     'Size all date labels and backgrounds
  389.     For i = 1 To 6 'Rows
  390.         'First set position and visibility of week number label
  391.         If Not bWeekNumbers Then
  392.             Me("lblWeek" & CStr(i)).Visible = False
  393.         Else
  394.             With Me("lblWeek" & CStr(i))
  395.                 .AutoSize = False
  396.                 .Height = lblDateDefaultHeight * RatioToResize
  397.                 .Font.Size = SizeFont
  398.                 .Width = bgDateDefaultWidth * RatioToResize
  399.                 .Left = BorderSpacing
  400.                 If i = 1 Then
  401.                     .Top = bgDayLabels.Top + bgDayLabels.Height + (((bgDateDefaultHeight * RatioToResize) - .Height) / 2)
  402.                 Else
  403.                     .Top = Me("bgDate" & CStr(i - 1) & "1").Top + Me("bgDate" & CStr(i - 1) & "1").Height + (((bgDateDefaultHeight * RatioToResize) - .Height) / 2)
  404.                 End If
  405.             End With
  406.         End If
  407.        
  408.         'Now set position of each date label in current row
  409.         For j = 1 To 7
  410.             Set bgControl = Me("bgDate" & CStr(i) & CStr(j))
  411.             Set lblControl = Me("lblDate" & CStr(i) & CStr(j))
  412.             'The date label background is sized and placed first. Then the actual date label is simply
  413.             'set to the same position and centered vertically.
  414.             With bgControl
  415.                 .Height = bgDateDefaultHeight * RatioToResize
  416.                 .Width = bgDateDefaultWidth * RatioToResize
  417.                 If j = 1 Then
  418.                     'Left position of first label in row depends on whether week numbers are visible
  419.                     If bWeekNumbers Then
  420.                         .Left = Me("lblWeek" & CStr(i)).Left + Me("lblWeek" & CStr(i)).Width + BorderSpacing
  421.                     Else
  422.                         .Left = BorderSpacing
  423.                     End If
  424.                 Else 'All other labels placed directly next to preceding label in row
  425.                     .Left = Me("bgDate" & CStr(i) & CStr(j - 1)).Left + Me("bgDate" & CStr(i) & CStr(j - 1)).Width
  426.                 End If
  427.                 If i = 1 Then
  428.                     .Top = bgDayLabels.Top + bgDayLabels.Height
  429.                 Else
  430.                     .Top = Me("bgDate" & CStr(i - 1) & CStr(j)).Top + Me("bgDate" & CStr(i - 1) & CStr(j)).Height
  431.                 End If
  432.             End With
  433.             'Size and position actual date label
  434.             With lblControl
  435.                 .AutoSize = False
  436.                 .Height = lblDateDefaultHeight * RatioToResize
  437.                 .Font.Size = SizeFont
  438.                 .Width = bgControl.Width
  439.                 .Left = bgControl.Left
  440.                 .Top = bgControl.Top + ((bgControl.Height - .Height) / 2)
  441.             End With
  442.         Next j
  443.     Next i
  444.    
  445.     'Set userform width. Height set later, since it depends on Today and Okay buttons
  446.     frameCalendar.Width = bgDate67.Left + bgDate67.Width + BorderSpacing
  447.     'Make sure userform is large enough to show entire calendar
  448.     If Me.InsideWidth < (frameCalendar.Left + frameCalendar.Width) Then
  449.         Me.Width = Me.Width + ((frameCalendar.Left + frameCalendar.Width) - Me.InsideWidth)
  450.     End If
  451.  
  452.     'Set size and visibility of Okay button and date selection labels
  453.     If Not OkayEnabled Then
  454.         cmdOkay.Visible = False
  455.         lblSelection.Visible = False
  456.         lblSelectionDate.Visible = False
  457.     Else
  458.         'Okay button. I set a maximum and width, for the same reason as the month
  459.         'scroll bar. Eventually, the gigantic buttons just start looking weird.
  460.         With cmdOkay
  461.             .Visible = True
  462.             .Height = cmdButtonDefaultHeight * RatioToResize
  463.             If .Height > cmdButtonsMaxHeight Then .Height = cmdButtonsMaxHeight
  464.             .Width = cmdButtonDefaultWidth * RatioToResize
  465.             If .Width > cmdButtonsMaxWidth Then .Width = cmdButtonsMaxWidth
  466.             If SizeFont > cmdButtonsMaxFontSize Then
  467.                 .Font.Size = cmdButtonsMaxFontSize
  468.             Else
  469.                 .Font.Size = SizeFont
  470.             End If
  471.             .Top = bgDate61.Top + bgDate61.Height + bgDayLabels.Height + BorderSpacing
  472.         End With
  473.         'The "Selection" label
  474.         With lblSelection
  475.             .Visible = True
  476.             .AutoSize = False
  477.             .Height = lblMonthYearDefaultHeight * RatioToResize
  478.             .Width = frameCalendar.Width
  479.             .Font.Size = HeaderDefaultFontSize * RatioToResize
  480.             .AutoSize = True
  481.             .Top = (bgDate61.Top + bgDate61.Height) + ((bgDayLabels.Height + BorderSpacing - .Height) / 2)
  482.         End With
  483.         'The actual selected date label
  484.         With lblSelectionDate
  485.             .Visible = True
  486.             .AutoSize = False
  487.             .Height = lblMonthYearDefaultHeight * RatioToResize
  488.             .Width = frameCalendar.Width - lblSelection.Width
  489.             .Font.Size = HeaderDefaultFontSize * RatioToResize
  490.             .Top = lblSelection.Top
  491.         End With
  492.     End If
  493.    
  494.     'Set size and visibility of Today button. Make sure it is within max bounds.
  495.     'Top is not set for Today button yet, because it depends on whether Okay button
  496.     'is enabled. Therefore, it is set farther down.
  497.     If Not TodayEnabled Then
  498.         cmdToday.Visible = False
  499.     Else
  500.         With cmdToday
  501.             .Visible = True
  502.             .Height = cmdButtonDefaultHeight * RatioToResize
  503.             If .Height > cmdButtonsMaxHeight Then .Height = cmdButtonsMaxHeight
  504.             .Width = cmdButtonDefaultWidth * RatioToResize
  505.             If .Width > cmdButtonsMaxWidth Then .Width = cmdButtonsMaxWidth
  506.             If SizeFont > cmdButtonsMaxFontSize Then
  507.                 .Font.Size = cmdButtonsMaxFontSize
  508.             Else
  509.                 .Font.Size = SizeFont
  510.             End If
  511.         End With
  512.     End If
  513.    
  514.     'Position Okay and Today buttons, depending on which ones are enabled
  515.     If OkayEnabled And TodayEnabled Then 'Both buttons enabled.
  516.         cmdToday.Top = cmdOkay.Top
  517.         cmdButtonsCombinedWidth = cmdToday.Width + cmdOkay.Width
  518.         cmdToday.Left = ((frameCalendar.Width - cmdButtonsCombinedWidth) / 2) - (BorderSpacing / 2)
  519.         cmdOkay.Left = cmdToday.Left + cmdToday.Width + BorderSpacing
  520.     ElseIf OkayEnabled Then 'Only Okay button enabled
  521.         cmdOkay.Left = (frameCalendar.Width - cmdOkay.Width) / 2
  522.     ElseIf TodayEnabled Then 'Only Today button enabled
  523.         cmdToday.Top = bgDate61.Top + bgDate61.Height + BorderSpacing
  524.         cmdToday.Left = (frameCalendar.Width - cmdToday.Width) / 2
  525.     End If
  526.    
  527.     'Set userform height, depending on which buttons are enabled
  528.     HeightOffset = Me.Height - Me.InsideHeight
  529.     If OkayEnabled Then
  530.         frameCalendar.Height = cmdOkay.Top + cmdOkay.Height + HeightOffset + BorderSpacing
  531.     ElseIf TodayEnabled Then 'Only Today button enabled
  532.         frameCalendar.Height = cmdToday.Top + cmdToday.Height + HeightOffset + BorderSpacing
  533.     Else 'Neither button enabled
  534.         frameCalendar.Height = bgDate61.Top + bgDate61.Height + HeightOffset + BorderSpacing
  535.     End If
  536.    
  537.     'Make sure userform is large enough to show entire calendar
  538.     If Me.InsideHeight < (frameCalendar.Top + frameCalendar.Height) Then
  539.         Me.Height = Me.Height + ((frameCalendar.Top + frameCalendar.Height) - Me.InsideHeight - HeightOffset)
  540.     End If
  541.    
  542.     'Check if SelectedDateIn was set by user, and ensure it is within min/max range
  543.     If SelectedDate > 0 Then
  544.         If SelectedDate < MinDate Then
  545.             SelectedDate = MinDate
  546.         ElseIf SelectedDate > MaxDate Then
  547.             SelectedDate = MaxDate
  548.         End If
  549.         SelectedDateIn = SelectedDate
  550.         SelectedYear = Year(SelectedDateIn)
  551.         SelectedMonth = Month(SelectedDateIn)
  552.         SelectedDay = Day(SelectedDateIn)
  553.         Call SetSelectionLabel(SelectedDateIn)
  554.     Else 'No SelectedDate provided, default to today's date
  555.         cmdOkay.Enabled = False
  556.         TempDate = Date
  557.         If TempDate < MinDate Then
  558.             TempDate = MinDate
  559.         ElseIf TempDate > MaxDate Then
  560.             TempDate = MaxDate
  561.         End If
  562.         SelectedYear = Year(TempDate)
  563.         SelectedMonth = Month(TempDate)
  564.         SelectedDay = 0 'Don't want to highlight a 'selected date,' since user supplied no date
  565.         Call SetSelectionLabel(Empty)
  566.     End If
  567.    
  568.     'Initialize month and year comboboxes, as well as month scroll bar. Make sure
  569.     'years are within range of 1900 to 9999. If year combobox falls outside bounds
  570.     'of MinDate and MaxDate, it will be overridden.
  571.     Call SetMonthCombobox(SelectedYear, SelectedMonth)
  572.     scrlMonth.value = SelectedMonth
  573.     cmbYearMin = SelectedYear - RangeOfYears
  574.     cmbYearMax = SelectedYear + RangeOfYears
  575.     If cmbYearMin < Year(MinDate) Then
  576.         cmbYearMin = Year(MinDate)
  577.     End If
  578.     If cmbYearMax > Year(MaxDate) Then
  579.         cmbYearMax = Year(MaxDate)
  580.     End If
  581.     For i = cmbYearMin To cmbYearMax
  582.         cmbYear.AddItem i
  583.     Next i
  584.     cmbYear.value = SelectedYear
  585.    
  586.     'Set userform colors and effects
  587.     Me.BackColor = BackgroundColor
  588.     frameCalendar.BackColor = BackgroundColor
  589.     bgHeader.BackColor = HeaderColor
  590.     bgScrollCover.BackColor = HeaderColor
  591.     lblMonth.ForeColor = HeaderFontColor
  592.     lblYear.ForeColor = HeaderFontColor
  593.     lblSelection.ForeColor = SubHeaderFontColor
  594.     lblSelectionDate.ForeColor = SubHeaderFontColor
  595.     bgDayLabels.BackColor = SubHeaderColor
  596.     For i = 1 To 7
  597.         Me("lblDay" & CStr(i)).ForeColor = SubHeaderFontColor
  598.     Next i
  599.     If bWeekNumbers Then
  600.         lblWk.ForeColor = SubHeaderFontColor
  601.         For i = 1 To 6
  602.             Me("lblWeek" & CStr(i)).ForeColor = SubHeaderFontColor
  603.         Next i
  604.     End If
  605.     For i = 1 To 6
  606.         For j = 1 To 7
  607.             With Me("bgDate" & CStr(i) & CStr(j))
  608.                 If DateBorder Then
  609.                     .BorderStyle = fmBorderStyleSingle
  610.                     .BorderColor = DateBorderColor
  611.                 End If
  612.                 .SpecialEffect = DateSpecialEffect
  613.             End With
  614.         Next j
  615.     Next i
  616.    
  617.     'Initialize subheader day labels, based on selected first day of week
  618.     TempDayOfWeek = StartWeek
  619.     For i = 1 To 7
  620.         Me("lblDay" & CStr(i)).Caption = Choose(TempDayOfWeek, "Su", "Mo", "Tu", "We", "Th", "Fr", "Sa")
  621.         TempDayOfWeek = TempDayOfWeek + 1
  622.         If TempDayOfWeek = 8 Then TempDayOfWeek = 1
  623.     Next i
  624.            
  625.     'Set month and year labels in header, as well as date labels
  626.     Call SetMonthYear(SelectedMonth, SelectedYear)
  627.     Call SetDays(SelectedMonth, SelectedYear, SelectedDay)
  628. End Sub
  629.  
  630.  
  631.  
  632. Private Sub bgHeader_Click()
  633.  
  634. End Sub
  635.  
  636. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  637. ' cmdOkay_Click
  638. '
  639. ' When the Okay button is clicked, DateOut is set, and the CalendarForm is hidden to
  640. ' return control to the GetDate function.
  641. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  642. Private Sub cmdOkay_Click()
  643.     DateOut = SelectedDateIn
  644.     Me.Hide
  645. End Sub
  646.  
  647.  
  648. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  649. ' cmdToday_Click
  650. '
  651. ' The functionality of the Today button changes depending on whether the Okay button is
  652. ' enabled or not. If the Okay button is enabled, clicking the Today button jumps to
  653. ' today's date and selects it.
  654. '
  655. ' If the Okay button is disabled, clicking the Today button jumps to today's date, but
  656. ' nothing is selected.
  657. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  658. Private Sub cmdToday_Click()
  659.     Dim SelectedMonth As Long           'Month of selected date
  660.     Dim SelectedYear As Long            'Year of selected date
  661.     Dim SelectedDay As Long             'Day of selected date, if applicable
  662.     Dim TodayDate As Date               'Today's date
  663.    
  664.     UserformEventsEnabled = False
  665.     SelectedDay = 0
  666.     TodayDate = Date
  667.    
  668.     'If Okay button is enabled, set SelectedDateIn, and the selection labels
  669.     If OkayEnabled Then
  670.         cmdOkay.Enabled = True
  671.         SelectedDateIn = TodayDate
  672.         Call SetSelectionLabel(TodayDate)
  673.         SelectedDay = Day(TodayDate)
  674.     End If
  675.    
  676.     'Get the month, day, and year, and set month scroll bar
  677.     SelectedMonth = Month(TodayDate)
  678.     SelectedYear = Year(TodayDate)
  679.     SelectedDay = GetSelectedDay(SelectedMonth, SelectedYear)
  680.     scrlMonth.value = SelectedMonth
  681.    
  682.     'Set month/year labels and date labels
  683.     Call SetMonthYear(SelectedMonth, SelectedYear)
  684.     Call SetDays(SelectedMonth, SelectedYear, SelectedDay)
  685.    
  686.     UserformEventsEnabled = True
  687. End Sub
  688.  
  689.  
  690. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  691. ' UserForm_QueryClose
  692. '
  693. ' I originally included this sub to override when the user cancelled the
  694. ' CalendarForm using the X button, in order to avoid receiving an invalid date value
  695. ' back from the userform (1/0/1900 12:00:00 AM). This sub sets DateOut to currently
  696. ' selected Date, or to the initial SelectedDate passed to the GetDate function if user
  697. ' has not changed the selection, or the Okay button is not enabled.
  698. '
  699. ' Note that it is still possible for the CalendarForm to return an invalid date value
  700. ' if no initial SelectedDate is set, the user does not make any selection, and then
  701. ' cancels the userform.
  702. '
  703. ' I ended up removing the sub, because I like being able to detect if the user has
  704. ' cancelled the userform by testing the date from it. For instance, if user selects
  705. ' a date, but then changes their mind and cancels the userform, you wouldn't want to
  706. ' still return that date to your variable. You would want to revert to their previous
  707. ' selection, or do some error handling, if necessary.
  708. '
  709. ' If you want the functionality described above, of returning the selected date or
  710. ' initial date if the user cancels, you can un-comment this sub.
  711. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  712. 'Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  713. '    If CloseMode = 0 Then
  714. '        Cancel = True
  715. '        DateOut = SelectedDateIn
  716. '        Me.Hide
  717. '    End If
  718. 'End Sub
  719.  
  720.  
  721. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  722. ' ClickControl
  723. '
  724. ' This sub handles the event of clicking on one of the date label controls. Every date
  725. ' label has a click event which passes that label to this sub.
  726. '
  727. ' If the Okay button is enabled, clicking a date selects that date, but does not return.
  728. ' If Okay button is disabled, clicking a date hides the userform and returns that date.
  729. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  730. Private Sub ClickControl(ctrl As MSForms.Control)
  731.     Dim SelectedMonth As Long           'Month of selected date
  732.     Dim SelectedYear As Long            'Year of selected date
  733.     Dim SelectedDay As Long             'Day of selected date
  734.     Dim SelectedDate As Date            'Date that the user has selected
  735.     Dim rowIndex As Long                'Row index of the clicked date label
  736.     Dim ColumnIndex As Long             'Column index of the clicked date label
  737.    
  738.     'Get selected day/year from scroll bar and combobox
  739.     SelectedMonth = scrlMonth.value
  740.     SelectedYear = cmbYear.value
  741.    
  742.     'Get indices of date label from label name and selected day from caption
  743.     rowIndex = CLng(Left(Right(ctrl.Name, 2), 1))
  744.     ColumnIndex = CLng(Right(ctrl.Name, 1))
  745.     SelectedDay = CLng(ctrl.Caption)
  746.    
  747.     'Selection is from previous month. The largest day that could exist in
  748.     'the first row from the current month is 6, so if the day is larger than
  749.     'that, we know it came from the previous month, in which case we need
  750.     'to decrement the selected month
  751.     If rowIndex = 1 And SelectedDay > 7 Then
  752.         SelectedMonth = SelectedMonth - 1
  753.         'Handle January
  754.         If SelectedMonth = 0 Then
  755.             SelectedYear = SelectedYear - 1
  756.             SelectedMonth = 12
  757.         End If
  758.    
  759.     'Selection is from next month. The trailing dates from next month can
  760.     'show up in rows 5 and 6. The smallest day that could exist in these rows
  761.     'from the current month is about 23, so if the day is smaller than that,
  762.     'we know it came from next month.
  763.     ElseIf rowIndex >= 5 And SelectedDay < 20 Then
  764.         SelectedMonth = SelectedMonth + 1
  765.         'Handle December
  766.         If SelectedMonth = 13 Then
  767.             SelectedYear = SelectedYear + 1
  768.             SelectedMonth = 1
  769.         End If
  770.     End If
  771.    
  772.     SelectedDate = DateSerial(SelectedYear, SelectedMonth, SelectedDay)
  773.    
  774.     'If Okay button is disabled, click will automatically hide form to return selected
  775.     'date. If Okay button is enabled, click will select date, but will not return until
  776.     'Okay is clicked
  777.     If Not OkayEnabled Then
  778.         DateOut = SelectedDate
  779.         Me.Hide
  780.     Else
  781.         UserformEventsEnabled = False
  782.             cmdOkay.Enabled = True
  783.             SelectedDateIn = SelectedDate
  784.             scrlMonth.value = SelectedMonth
  785.             Call SetSelectionLabel(SelectedDate)
  786.             Call SetMonthYear(SelectedMonth, SelectedYear)
  787.             Call SetDays(SelectedMonth, SelectedYear, SelectedDay)
  788.         UserformEventsEnabled = True
  789.     End If
  790. End Sub
  791.  
  792.  
  793. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  794. ' HoverControl
  795. '
  796. ' This sub handles the event of hovering over one of the date label controls. Every date
  797. ' label has a MouseMove event which passes that label to this sub.
  798. '
  799. ' This sub returns the last hovered date label to its original color, sets the currently
  800. ' hovered date label to the bgDateHoverColor, and stores its name and original color
  801. ' to global variables.
  802. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  803. Private Sub HoverControl(ctrl As MSForms.Control)
  804.     If HoverControlName <> vbNullString Then
  805.         Me.Controls(HoverControlName).BackColor = HoverControlColor
  806.     End If
  807.     HoverControlName = ctrl.Name
  808.     HoverControlColor = ctrl.BackColor
  809.     ctrl.BackColor = bgDateHoverColor
  810. End Sub
  811.  
  812.  
  813. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  814. ' lblMonth_Click / lblYear_Click
  815. '
  816. ' The month and year labels in the header have invisible comboboxes behind them. These
  817. ' two subs show the combobox drop downs when you click on the labels.
  818. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  819. Private Sub lblMonth_Click()
  820.     cmbMonth.DropDown
  821. End Sub
  822. Private Sub lblYear_Click()
  823.     cmbYear.DropDown
  824. End Sub
  825.  
  826.  
  827. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  828. ' cmbMonth_Change / cmbYear_Change
  829. '
  830. ' The month and year comboboxes both call the cmbMonthYearChange sub when the user makes
  831. ' a selection. The year combobox also resets the month combobox, in case the user
  832. ' selects a year that is limited by a minimum or maximum date, to make sure the month
  833. ' combobox doesn't end up with selections that shouldn't be available.
  834. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  835. Private Sub cmbMonth_Change()
  836.     Call cmbMonthYearChange
  837. End Sub
  838. Private Sub cmbYear_Change()
  839.     If Not UserformEventsEnabled Then Exit Sub
  840.    
  841.     UserformEventsEnabled = False
  842.     Call SetMonthCombobox(cmbYear.value, scrlMonth.value)
  843.     UserformEventsEnabled = True
  844.    
  845.     Call cmbMonthYearChange
  846. End Sub
  847.  
  848.  
  849. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  850. ' cmbMonthYearChange
  851. '
  852. ' This sub handles the user making a selection from either the month or year combobox.
  853. ' It gets the selected month and year from the comboboxes, sets the value of the month
  854. ' scroll bar to match, and resets the calendar date labels.
  855. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  856. Private Sub cmbMonthYearChange()
  857.     Dim SelectedMonth As Long           'Month of selected date
  858.     Dim SelectedYear As Long            'Year of selected date
  859.     Dim SelectedDay As Long             'Day of selected date
  860.    
  861.     If Not UserformEventsEnabled Then Exit Sub
  862.     UserformEventsEnabled = False
  863.    
  864.     'Get selected month and year. If the selected year has a minimum date set, then
  865.     'the month combobox might not contain all the months of the year. In this case
  866.     'the combobox index has to be offset by the month of the minimum date. No
  867.     'calculation is necessary if the selected year has a maximum date set, because
  868.     'the indices of the months in the combobox are still going to be the same in
  869.     'either case.
  870.     SelectedYear = cmbYear.value
  871.     If SelectedYear = Year(MinDate) Then
  872.         SelectedMonth = cmbMonth.ListIndex + Month(MinDate)
  873.     Else
  874.         SelectedMonth = cmbMonth.ListIndex + 1
  875.     End If
  876.    
  877.     'Get selected day, set the value of the month scroll bar, and reset all
  878.     'date labels on the userform
  879.     SelectedDay = GetSelectedDay(SelectedMonth, SelectedYear)
  880.     scrlMonth.value = SelectedMonth
  881.     Call SetMonthYear(SelectedMonth, SelectedYear)
  882.     Call SetDays(SelectedMonth, SelectedYear, SelectedDay)
  883.    
  884.     UserformEventsEnabled = True
  885. End Sub
  886.  
  887.  
  888. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  889. ' scrlMonth_Change
  890. '
  891. ' This sub handles the user clicking the scroll bar to increment or decrement the month.
  892. ' It checks to keep the month within the bounds set by the minimum or maximum date,
  893. ' and resets all the labels of the userform to the new month.
  894. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  895. Private Sub scrlMonth_Change()
  896.     Dim TempYear As Long        'Temporarily store selected year to test min and max dates
  897.     Dim MinMonth As Long        'Sets lower limit of scroll bar
  898.     Dim MaxMonth As Long        'Sets upper limit of scroll bar
  899.     Dim SelectedMonth As Long   'Month of selected date
  900.     Dim SelectedYear As Long    'Year of selected date
  901.     Dim SelectedDay As Long     'Day of selected date
  902.    
  903.     If Not UserformEventsEnabled Then Exit Sub
  904.     UserformEventsEnabled = False
  905.    
  906.     'Default lower and upper limit of scroll bar to allow full range of months
  907.     MinMonth = 0
  908.     MaxMonth = 13
  909.    
  910.     'If the current year is the min or max year, set min or max months
  911.     TempYear = cmbYear.value
  912.     If TempYear = Year(MinDate) Then MinMonth = Month(MinDate)
  913.     If TempYear = Year(MaxDate) Then MaxMonth = Month(MaxDate)
  914.    
  915.     'Keep scroll bar within range of min and max dates
  916.     If scrlMonth.value < MinMonth Then scrlMonth.value = scrlMonth.value + 1
  917.     If scrlMonth.value > MaxMonth Then scrlMonth.value = scrlMonth.value - 1
  918.    
  919.     'If user goes down one month from January, scroll bar will have value of
  920.     '0. In this case, reset scroll bar back to December and decrement year
  921.     'by 1.
  922.     If scrlMonth.value = 0 Then
  923.         scrlMonth.value = 12
  924.         cmbYear.value = cmbYear.value - 1
  925.         'If new year is outside range of combobox, add it to combobox
  926.         If cmbYear.value < cmbYearMin Then
  927.             cmbYear.AddItem cmbYear.value, 0
  928.             cmbYearMin = cmbYear.value
  929.         End If
  930.         Call SetMonthCombobox(cmbYear.value, scrlMonth.value)
  931.     'If user goes up one month from December, scroll bar will have value of
  932.     '13. Reset to January and increment year.
  933.     ElseIf scrlMonth.value = 13 Then
  934.         scrlMonth.value = 1
  935.         cmbYear.value = cmbYear.value + 1
  936.         'If new year is outside range of combobox, add it to combobox
  937.         If cmbYear.value > cmbYearMax Then
  938.             cmbYear.AddItem cmbYear.value, cmbYear.ListCount
  939.             cmbYearMax = cmbYear.value
  940.         End If
  941.         Call SetMonthCombobox(cmbYear.value, scrlMonth.value)
  942.     End If
  943.    
  944.     'Get selected month, year, and day, and reset all userform labels
  945.     SelectedMonth = scrlMonth.value
  946.     SelectedYear = cmbYear.value
  947.     SelectedDay = GetSelectedDay(SelectedMonth, SelectedYear)
  948.     Call SetMonthYear(SelectedMonth, SelectedYear)
  949.     Call SetDays(SelectedMonth, SelectedYear, SelectedDay)
  950.    
  951.     UserformEventsEnabled = True
  952. End Sub
  953.  
  954.  
  955. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  956. ' SetMonthCombobox
  957. '
  958. ' This sub clears the list in the month combobox and resets it. This is done every time
  959. ' the month changes to make sure the months displayed in the combobox don't ever fall
  960. ' outside the bounds set by the minimum or maximum date.
  961. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  962. Private Sub SetMonthCombobox(YearIn As Long, MonthIn As Long)
  963.     Dim YearMinDate As Long             'Year of the minimum date
  964.     Dim YearMaxDate As Long             'Year of the maximum date
  965.     Dim MonthMinDate As Long            'Month of the minimum date
  966.     Dim MonthMaxDate As Long            'Month of the maximum date
  967.     Dim i As Long                       'Used for looping
  968.    
  969.     'Get month and year of minimum and maximum dates and clear combobox
  970.     YearMinDate = Year(MinDate)
  971.     YearMaxDate = Year(MaxDate)
  972.     MonthMinDate = Month(MinDate)
  973.     MonthMaxDate = Month(MaxDate)
  974.     cmbMonth.Clear
  975.  
  976.     'Both minimum and maximum dates occur in selected year
  977.     If YearIn = YearMinDate And YearIn = YearMaxDate Then
  978.         For i = MonthMinDate To MonthMaxDate
  979.             cmbMonth.AddItem Choose(i, "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
  980.         Next i
  981.         If MonthIn < MonthMinDate Then MonthIn = MonthMinDate
  982.         If MonthIn > MonthMaxDate Then MonthIn = MonthMaxDate
  983.         cmbMonth.ListIndex = MonthIn - MonthMinDate
  984.    
  985.     'Only minimum date occurs in selected year
  986.     ElseIf YearIn = YearMinDate Then
  987.         For i = MonthMinDate To 12
  988.             cmbMonth.AddItem Choose(i, "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
  989.         Next i
  990.         If MonthIn < MonthMinDate Then MonthIn = MonthMinDate
  991.         cmbMonth.ListIndex = MonthIn - MonthMinDate
  992.    
  993.     'Only maximum date occurs in selected year
  994.     ElseIf YearIn = YearMaxDate Then
  995.         For i = 1 To MonthMaxDate
  996.             cmbMonth.AddItem Choose(i, "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
  997.         Next i
  998.         If MonthIn > MonthMaxDate Then MonthIn = MonthMaxDate
  999.         cmbMonth.ListIndex = MonthIn - 1
  1000.    
  1001.     'No minimum or maximum date in selected year. Add all months to combobox
  1002.     Else
  1003.         cmbMonth.List = Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
  1004.         cmbMonth.ListIndex = MonthIn - 1
  1005.     End If
  1006.  
  1007. End Sub
  1008.  
  1009.  
  1010. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1011. ' SetMonthYear
  1012. '
  1013. ' This sub sets the month and year comboboxes to keep them in sync with any changes
  1014. ' made to the selected month or year. It also sets the month and year labels in the
  1015. ' header, and positions them in the center of the month scroll bar.
  1016. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1017. Private Sub SetMonthYear(MonthIn As Long, YearIn As Long)
  1018.     Dim ExtraSpace As Double                'Space between month and year labels
  1019.     Dim CombinedLabelWidth As Double        'Combined width of both month and year labels
  1020.    
  1021.     ExtraSpace = 4 * RatioToResize
  1022.    
  1023.     'Set value of comboboxes
  1024.     If YearIn = Year(MinDate) Then
  1025.         cmbMonth.ListIndex = MonthIn - Month(MinDate)
  1026.     Else
  1027.         cmbMonth.ListIndex = MonthIn - 1
  1028.     End If
  1029.     cmbYear.value = YearIn
  1030.    
  1031.     'Set labels and position to center of scroll buttons. Labels are first
  1032.     'set to the width of the userform to avoid overflow, and then autosized
  1033.     'to fit to the text before being centered
  1034.     With lblMonth
  1035.         .AutoSize = False
  1036.         .Width = frameCalendar.Width
  1037.         .Caption = cmbMonth.value
  1038.         .AutoSize = True
  1039.     End With
  1040.     With lblYear
  1041.         .AutoSize = False
  1042.         .Width = frameCalendar.Width
  1043.         .Caption = cmbYear.value
  1044.         .AutoSize = True
  1045.     End With
  1046.    
  1047.     'Get combined width of labels and center to scroll bar
  1048.     CombinedLabelWidth = lblMonth.Width + lblYear.Width
  1049.     With lblMonth
  1050.         .Left = ((frameCalendar.Width - CombinedLabelWidth) / 2) - (ExtraSpace / 2)
  1051.     End With
  1052.     With lblYear
  1053.         .Left = lblMonth.Left + lblMonth.Width + ExtraSpace
  1054.     End With
  1055.    
  1056.     'Reposition comboboxes to line up with labels
  1057.     cmbMonth.Left = lblMonth.Left - (cmbMonth.Width - lblMonth.Width) - ExtraSpace - 2
  1058.     cmbYear.Left = lblYear.Left
  1059.    
  1060.     'Clear hover control name, so labels in new month don't revert to
  1061.     'colors from previously selected month
  1062.     HoverControlName = vbNullString
  1063. End Sub
  1064.  
  1065.  
  1066. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1067. ' SetDays
  1068. '
  1069. ' This sub sets the caption, visibility, and colors of all the date labels on the
  1070. ' userform, as well as the week number labels. If a selected day is passed to the
  1071. ' sub, it will highlight that date accordingly. Otherwise, no selected date will be
  1072. ' highlighted.
  1073. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1074. Private Sub SetDays(MonthIn As Long, YearIn As Long, Optional DayIn As Long)
  1075.     Dim PrevMonth As Long               'Month preceding selected month. Used for trailing dates
  1076.     Dim NextMonth As Long               'Month following selected month. Used for trailing dates
  1077.     Dim Today As Date                   'Today's date
  1078.     Dim TodayDay As Long                'Day number of today's date
  1079.     Dim StartDayOfWeek  As Long         'Stores the weekday number of the first day in selected month
  1080.     Dim LastDayOfMonth As Long          'Last day of the month
  1081.     Dim LastDayOfPrevMonth As Long      'Last day of preceding month. Used for trailing dates
  1082.     Dim CurrentDay As Long              'Tracks current day in the month while setting labels
  1083.     Dim TempCurrentDay As Long          'Tracks the current day for previous month without incrementing actual CurrentDay
  1084.     Dim WeekNumber As Long              'Stores week number for week number labels
  1085.     Dim StartDayOfWeekDate As Date      'Stores first date in the week. Used to calculate week numbers
  1086.     Dim SaturdayIndex As Long           'Column index of Saturdays. Used to set color of Saturday labels, if applicable
  1087.     Dim SundayIndex As Long             'Column index of Sundays
  1088.     Dim MinDay As Long                  'Stores lower limit of days if minimum date falls in selected month
  1089.     Dim MaxDay As Long                  'Stores upper limit of days if maximum date falls in selected month
  1090.     Dim PrevMonthMinDay As Long         'Stores lower limit of days if minimum date falls in preceding month
  1091.     Dim NextMonthMaxDay As Long         'Stores upper limit of days if maximum date falls in next month
  1092.     Dim lblControl As MSForms.Control   'Stores current date label while changing settings
  1093.     Dim bgControl As MSForms.Control    'Stores current date label background while changing settings
  1094.     Dim i As Long                       'Used for looping
  1095.     Dim j As Long                       'Used for looping
  1096.    
  1097.     'Set min and max day, if applicable. If not, min and max day are set to 0 and 32,
  1098.     'respectively, since dates will never fall outside those bounds
  1099.     MinDay = 0
  1100.     MaxDay = 32
  1101.     If YearIn = Year(MinDate) And MonthIn = Month(MinDate) Then MinDay = Day(MinDate)
  1102.     If YearIn = Year(MaxDate) And MonthIn = Month(MaxDate) Then MaxDay = Day(MaxDate)
  1103.    
  1104.     'Find previous month and next month. Handle January
  1105.     'and December appropriately
  1106.     PrevMonth = MonthIn - 1
  1107.     If PrevMonth = 0 Then PrevMonth = 12
  1108.     NextMonth = MonthIn + 1
  1109.     If NextMonth = 13 Then NextMonth = 1
  1110.    
  1111.     'Set min and max days for previous month and next month, if applicable
  1112.     PrevMonthMinDay = 0
  1113.     NextMonthMaxDay = 32
  1114.     If YearIn = Year(MinDate) And PrevMonth = Month(MinDate) Then PrevMonthMinDay = Day(MinDate)
  1115.     If YearIn = Year(MaxDate) And NextMonth = Month(MaxDate) Then NextMonthMaxDay = Day(MaxDate)
  1116.  
  1117.     'Find last day of selected month and previous month. Find first weekday
  1118.     'in current month, and index of Saturday and Sunday relative to first weekday
  1119.     LastDayOfMonth = Day(DateSerial(YearIn, MonthIn + 1, 0))
  1120.     LastDayOfPrevMonth = Day(DateSerial(YearIn, MonthIn, 0))
  1121.     StartDayOfWeek = Weekday(DateSerial(YearIn, MonthIn, 1), StartWeek)
  1122.     If StartWeek = 1 Then SundayIndex = 1 Else SundayIndex = 9 - StartWeek
  1123.     SaturdayIndex = 8 - StartWeek
  1124.  
  1125.     'If user is viewing current month/year, we want to highlight today's date. If
  1126.     'not, TodayDay is set to 0, since that value will never be encountered
  1127.     Today = Date
  1128.     If YearIn = Year(Today) And MonthIn = Month(Today) Then
  1129.         TodayDay = Day(Today)
  1130.     Else
  1131.         TodayDay = 0
  1132.     End If
  1133.    
  1134.     'Loop through all date labels and set captions and colors
  1135.     CurrentDay = 1
  1136.     For i = 1 To 6 'Rows
  1137.    
  1138.         'Set week number first, as it happens only once per row
  1139.         'Entire first row is last month
  1140.         If StartDayOfWeek = 1 And i = 1 Then
  1141.             'Calculate day number of first day in the week
  1142.             TempCurrentDay = CLng(LastDayOfPrevMonth - (StartDayOfWeek + 5))
  1143.             If PrevMonth <> 12 Then
  1144.                 StartDayOfWeekDate = DateSerial(YearIn, PrevMonth, TempCurrentDay)
  1145.             Else
  1146.                 StartDayOfWeekDate = DateSerial(YearIn - 1, PrevMonth, TempCurrentDay)
  1147.             End If
  1148.            
  1149.         'Previous month, but entire row is not last month. In this
  1150.         'case just use first of month. This is done because when using
  1151.         'the DatePart function to calculate week number, the last week
  1152.         'in December can be calculated incorrectly, so we want to default
  1153.         'to January 1st instead, which is always correct
  1154.         ElseIf i = 1 Then
  1155.             StartDayOfWeekDate = DateSerial(YearIn, MonthIn, 1)
  1156.        
  1157.         Else
  1158.             'Current month
  1159.             If CurrentDay <= LastDayOfMonth Then
  1160.                 TempCurrentDay = CurrentDay
  1161.                 StartDayOfWeekDate = DateSerial(YearIn, MonthIn, TempCurrentDay)
  1162.            
  1163.             'Next month
  1164.             Else
  1165.                 TempCurrentDay = CLng(CurrentDay - LastDayOfMonth)
  1166.                 If NextMonth <> 1 Then
  1167.                     StartDayOfWeekDate = DateSerial(YearIn, NextMonth, TempCurrentDay)
  1168.                 Else
  1169.                     StartDayOfWeekDate = DateSerial(YearIn + 1, NextMonth, TempCurrentDay)
  1170.                 End If
  1171.             End If
  1172.         End If
  1173.         WeekNumber = DatePart("ww", StartDayOfWeekDate, StartWeek, WeekOneOfYear)
  1174.        
  1175.         'Address DatePart function bug of sometimes incorrectly returning week 53
  1176.         'for last week in December when it should be week 1 of new year. If we get
  1177.         '53, but January 1st resides in the week we are calculating (any time the
  1178.         'first day of the week is greater than Dec 25th), we want to calculate based
  1179.         'off January 1st, instead of date in December.
  1180.         If WeekNumber > 52 And TempCurrentDay > 25 Then
  1181.             WeekNumber = DatePart("ww", DateSerial(YearIn + 1, 1, 1), StartWeek, WeekOneOfYear)
  1182.         End If
  1183.         Me("lblWeek" & CStr(i)).Caption = WeekNumber
  1184.        
  1185.         'Set date labels
  1186.         For j = 1 To 7 'Columns
  1187.             Set lblControl = Me("lblDate" & CStr(i) & CStr(j))
  1188.             Set bgControl = Me("bgDate" & CStr(i) & CStr(j))
  1189.             With lblControl
  1190.                
  1191.                 'Previous month dates. If month starts on first day of week, entire
  1192.                 'first row will be previous month
  1193.                 If StartDayOfWeek = 1 And i = 1 Then
  1194.                     'If minimum date is in current month, then previous month shouldn't be visible
  1195.                     If MinDay <> 0 Then
  1196.                         .Visible = False
  1197.                         bgControl.Visible = False
  1198.                     Else
  1199.                         TempCurrentDay = CLng(LastDayOfPrevMonth - (StartDayOfWeek + 6 - j))
  1200.                         'Make sure previous month dates don't go beyond minimum date
  1201.                         If TempCurrentDay < PrevMonthMinDay Then
  1202.                             .Visible = False
  1203.                             bgControl.Visible = False
  1204.                         Else
  1205.                             .Visible = True
  1206.                             bgControl.Visible = True
  1207.                             .ForeColor = lblDatePrevMonthColor
  1208.                             .Caption = CStr(TempCurrentDay)
  1209.                             bgControl.BackColor = bgDateColor
  1210.                         End If
  1211.                     End If
  1212.                    
  1213.                 'Previous month dates if month DOESN'T start on first day of week
  1214.                 ElseIf i = 1 And j < StartDayOfWeek Then
  1215.                     'If minimum date is in current month, then previous month shouldn't be visible
  1216.                     If MinDay <> 0 Then
  1217.                         .Visible = False
  1218.                         bgControl.Visible = False
  1219.                     Else
  1220.                         TempCurrentDay = CLng(LastDayOfPrevMonth - (StartDayOfWeek - 1 - j))
  1221.                         'Make sure previous month dates don't go beyond minimum date
  1222.                         If TempCurrentDay < PrevMonthMinDay Then
  1223.                             .Visible = False
  1224.                             bgControl.Visible = False
  1225.                         Else
  1226.                             .Visible = True
  1227.                             .Enabled = True
  1228.                             bgControl.Visible = True
  1229.                             .ForeColor = lblDatePrevMonthColor
  1230.                             .Caption = CStr(TempCurrentDay)
  1231.                             bgControl.BackColor = bgDateColor
  1232.                         End If
  1233.                     End If
  1234.  
  1235.                 'Next month dates
  1236.                 ElseIf CurrentDay > LastDayOfMonth Then
  1237.                     'If maximum date is in current month, then next month shouldn't be visible
  1238.                     If MaxDay <> 32 Then
  1239.                         .Visible = False
  1240.                         bgControl.Visible = False
  1241.                     Else
  1242.                         TempCurrentDay = CLng(CurrentDay - LastDayOfMonth)
  1243.                         'Make sure next month dates don't go beyond maximum date
  1244.                         If TempCurrentDay > NextMonthMaxDay Then
  1245.                             .Visible = False
  1246.                             bgControl.Visible = False
  1247.                         Else
  1248.                             .Visible = True
  1249.                             .Enabled = True
  1250.                             bgControl.Visible = True
  1251.                             .ForeColor = lblDatePrevMonthColor
  1252.                             .Caption = CStr(TempCurrentDay)
  1253.                             bgControl.BackColor = bgDateColor
  1254.                         End If
  1255.                     End If
  1256.                     CurrentDay = CurrentDay + 1
  1257.                    
  1258.                 'Current month dates
  1259.                 Else
  1260.                     'Disable any dates outside bounds of minimum or maximum dates.
  1261.                     'Background of date label is set to invisible, so it doesn't
  1262.                     'hover, and the date label itself is disabled so it can't be clicked
  1263.                     If CurrentDay < MinDay Or CurrentDay > MaxDay Then
  1264.                         .Visible = True
  1265.                         .Enabled = False
  1266.                         bgControl.Visible = False
  1267.                     Else 'Within bounds. Enable and set colors
  1268.                         .Visible = True
  1269.                         .Enabled = True
  1270.                         bgControl.Visible = True
  1271.                         'Set text color
  1272.                         If CurrentDay = TodayDay Then
  1273.                             .ForeColor = lblDateTodayColor
  1274.                         ElseIf j = SaturdayIndex Then
  1275.                             .ForeColor = lblDateSatColor
  1276.                         ElseIf j = SundayIndex Then
  1277.                             .ForeColor = lblDateSunColor
  1278.                         Else
  1279.                             .ForeColor = lblDateColor
  1280.                         End If
  1281.                        
  1282.                         'Set background color
  1283.                         If CurrentDay = DayIn Then
  1284.                             bgControl.BackColor = bgDateSelectedColor
  1285.                         Else
  1286.                             bgControl.BackColor = bgDateColor
  1287.                         End If
  1288.                     End If
  1289.                     .Caption = CStr(CurrentDay)
  1290.                     CurrentDay = CurrentDay + 1
  1291.                 End If
  1292.             End With
  1293.         Next j
  1294.     Next i
  1295. End Sub
  1296.  
  1297.  
  1298. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1299. ' SetSelectionLabel
  1300. '
  1301. ' This sub sets the caption and position of the labels that show the user's current
  1302. ' selection if the Okay button is enabled.
  1303. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1304. Private Sub SetSelectionLabel(DateIn As Date)
  1305.     Dim CombinedLabelWidth As Double        'Combined width of both labels, used to center
  1306.     Dim ExtraSpace As Double                'Space between the two labels
  1307.    
  1308.     ExtraSpace = 3 * RatioToResize
  1309.    
  1310.     'If there is no selected date set yet, selected date label should be null
  1311.     If DateIn = 0 Then
  1312.         lblSelectionDate.Caption = vbNullString
  1313.         lblSelection.Left = frameCalendar.Left + ((frameCalendar.Width - lblSelection.Width) / 2)
  1314.     Else 'A selection has been made. Set caption and center
  1315.         With lblSelectionDate
  1316.             .AutoSize = False
  1317.             .Width = frameCalendar.Width
  1318.             .Caption = Format(DateIn, "mm/dd/yyyy")
  1319.             .AutoSize = True
  1320.         End With
  1321.    
  1322.         CombinedLabelWidth = lblSelection.Width + lblSelectionDate.Width
  1323.         lblSelection.Left = ((frameCalendar.Width - CombinedLabelWidth) / 2) - (ExtraSpace / 2)
  1324.         lblSelectionDate.Left = lblSelection.Left + lblSelection.Width + ExtraSpace
  1325.     End If
  1326. End Sub
  1327.  
  1328.  
  1329. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1330. ' GetSelectedDay
  1331. '
  1332. ' This function checks the current month and year to see if they match the selected
  1333. ' date. If so, it returns the day number of the selected date. If not, it returns 0.
  1334. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1335. Private Function GetSelectedDay(MonthIn As Long, YearIn As Long) As Long
  1336.     GetSelectedDay = 0
  1337.    
  1338.     'Check if a selected date was provided by the user
  1339.     If SelectedDateIn <> 0 Then
  1340.         If MonthIn = Month(SelectedDateIn) And YearIn = Year(SelectedDateIn) Then
  1341.             GetSelectedDay = Day(SelectedDateIn)
  1342.         End If
  1343.     End If
  1344. End Function
  1345.  
  1346.  
  1347. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1348. ' Min / Max
  1349. '
  1350. ' Get the min/max of an arbitrary number of arguments
  1351. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1352. Private Function Min(ParamArray values() As Variant) As Variant
  1353.    Dim minValue As Variant
  1354.    Dim value As Variant
  1355.    minValue = values(0)
  1356.    For Each value In values
  1357.        If value < minValue Then minValue = value
  1358.    Next
  1359.    Min = minValue
  1360. End Function
  1361. Private Function Max(ParamArray values() As Variant) As Variant
  1362.    Dim maxValue As Variant
  1363.    Dim value As Variant
  1364.    maxValue = values(0)
  1365.    For Each value In values
  1366.        If value > maxValue Then maxValue = value
  1367.    Next
  1368.    Max = maxValue
  1369. End Function
  1370.  
  1371.  
  1372. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1373. ' The following subs all call the ClickControl sub, passing the date label that has been
  1374. ' clicked. It could have saved some lines of code to create a class module which handled
  1375. ' the functionality of hovering and clicking on the different controls, then simply
  1376. ' declaring each date label as an object of that class. However, that would have
  1377. ' necessitated the inclusion of another module in order to make the CalendarForm function
  1378. ' properly. Since the main goal of this project was to have this userform be completely
  1379. ' self-contained, I opted for this route.
  1380. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1381. 'User clicked on the background of the date label
  1382. Private Sub bgDate11_Click(): ClickControl lblDate11: End Sub
  1383. Private Sub bgDate12_Click(): ClickControl lblDate12: End Sub
  1384. Private Sub bgDate13_Click(): ClickControl lblDate13: End Sub
  1385. Private Sub bgDate14_Click(): ClickControl lblDate14: End Sub
  1386. Private Sub bgDate15_Click(): ClickControl lblDate15: End Sub
  1387. Private Sub bgDate16_Click(): ClickControl lblDate16: End Sub
  1388. Private Sub bgDate17_Click(): ClickControl lblDate17: End Sub
  1389. Private Sub bgDate21_Click(): ClickControl lblDate21: End Sub
  1390. Private Sub bgDate22_Click(): ClickControl lblDate22: End Sub
  1391. Private Sub bgDate23_Click(): ClickControl lblDate23: End Sub
  1392. Private Sub bgDate24_Click(): ClickControl lblDate24: End Sub
  1393. Private Sub bgDate25_Click(): ClickControl lblDate25: End Sub
  1394. Private Sub bgDate26_Click(): ClickControl lblDate26: End Sub
  1395. Private Sub bgDate27_Click(): ClickControl lblDate27: End Sub
  1396. Private Sub bgDate31_Click(): ClickControl lblDate31: End Sub
  1397. Private Sub bgDate32_Click(): ClickControl lblDate32: End Sub
  1398. Private Sub bgDate33_Click(): ClickControl lblDate33: End Sub
  1399. Private Sub bgDate34_Click(): ClickControl lblDate34: End Sub
  1400. Private Sub bgDate35_Click(): ClickControl lblDate35: End Sub
  1401. Private Sub bgDate36_Click(): ClickControl lblDate36: End Sub
  1402. Private Sub bgDate37_Click(): ClickControl lblDate37: End Sub
  1403. Private Sub bgDate41_Click(): ClickControl lblDate41: End Sub
  1404. Private Sub bgDate42_Click(): ClickControl lblDate42: End Sub
  1405. Private Sub bgDate43_Click(): ClickControl lblDate43: End Sub
  1406. Private Sub bgDate44_Click(): ClickControl lblDate44: End Sub
  1407. Private Sub bgDate45_Click(): ClickControl lblDate45: End Sub
  1408. Private Sub bgDate46_Click(): ClickControl lblDate46: End Sub
  1409. Private Sub bgDate47_Click(): ClickControl lblDate47: End Sub
  1410. Private Sub bgDate51_Click(): ClickControl lblDate51: End Sub
  1411. Private Sub bgDate52_Click(): ClickControl lblDate52: End Sub
  1412. Private Sub bgDate53_Click(): ClickControl lblDate53: End Sub
  1413. Private Sub bgDate54_Click(): ClickControl lblDate54: End Sub
  1414. Private Sub bgDate55_Click(): ClickControl lblDate55: End Sub
  1415. Private Sub bgDate56_Click(): ClickControl lblDate56: End Sub
  1416. Private Sub bgDate57_Click(): ClickControl lblDate57: End Sub
  1417. Private Sub bgDate61_Click(): ClickControl lblDate61: End Sub
  1418. Private Sub bgDate62_Click(): ClickControl lblDate62: End Sub
  1419. Private Sub bgDate63_Click(): ClickControl lblDate63: End Sub
  1420. Private Sub bgDate64_Click(): ClickControl lblDate64: End Sub
  1421. Private Sub bgDate65_Click(): ClickControl lblDate65: End Sub
  1422. Private Sub bgDate66_Click(): ClickControl lblDate66: End Sub
  1423. Private Sub bgDate67_Click(): ClickControl lblDate67: End Sub
  1424. 'User clicked on the actual date label itself
  1425. Private Sub lblDate11_Click(): ClickControl lblDate11: End Sub
  1426. Private Sub lblDate12_Click(): ClickControl lblDate12: End Sub
  1427. Private Sub lblDate13_Click(): ClickControl lblDate13: End Sub
  1428. Private Sub lblDate14_Click(): ClickControl lblDate14: End Sub
  1429. Private Sub lblDate15_Click(): ClickControl lblDate15: End Sub
  1430. Private Sub lblDate16_Click(): ClickControl lblDate16: End Sub
  1431. Private Sub lblDate17_Click(): ClickControl lblDate17: End Sub
  1432. Private Sub lblDate21_Click(): ClickControl lblDate21: End Sub
  1433. Private Sub lblDate22_Click(): ClickControl lblDate22: End Sub
  1434. Private Sub lblDate23_Click(): ClickControl lblDate23: End Sub
  1435. Private Sub lblDate24_Click(): ClickControl lblDate24: End Sub
  1436. Private Sub lblDate25_Click(): ClickControl lblDate25: End Sub
  1437. Private Sub lblDate26_Click(): ClickControl lblDate26: End Sub
  1438. Private Sub lblDate27_Click(): ClickControl lblDate27: End Sub
  1439. Private Sub lblDate31_Click(): ClickControl lblDate31: End Sub
  1440. Private Sub lblDate32_Click(): ClickControl lblDate32: End Sub
  1441. Private Sub lblDate33_Click(): ClickControl lblDate33: End Sub
  1442. Private Sub lblDate34_Click(): ClickControl lblDate34: End Sub
  1443. Private Sub lblDate35_Click(): ClickControl lblDate35: End Sub
  1444. Private Sub lblDate36_Click(): ClickControl lblDate36: End Sub
  1445. Private Sub lblDate37_Click(): ClickControl lblDate37: End Sub
  1446. Private Sub lblDate41_Click(): ClickControl lblDate41: End Sub
  1447. Private Sub lblDate42_Click(): ClickControl lblDate42: End Sub
  1448. Private Sub lblDate43_Click(): ClickControl lblDate43: End Sub
  1449. Private Sub lblDate44_Click(): ClickControl lblDate44: End Sub
  1450. Private Sub lblDate45_Click(): ClickControl lblDate45: End Sub
  1451. Private Sub lblDate46_Click(): ClickControl lblDate46: End Sub
  1452. Private Sub lblDate47_Click(): ClickControl lblDate47: End Sub
  1453. Private Sub lblDate51_Click(): ClickControl lblDate51: End Sub
  1454. Private Sub lblDate52_Click(): ClickControl lblDate52: End Sub
  1455. Private Sub lblDate53_Click(): ClickControl lblDate53: End Sub
  1456. Private Sub lblDate54_Click(): ClickControl lblDate54: End Sub
  1457. Private Sub lblDate55_Click(): ClickControl lblDate55: End Sub
  1458. Private Sub lblDate56_Click(): ClickControl lblDate56: End Sub
  1459. Private Sub lblDate57_Click(): ClickControl lblDate57: End Sub
  1460. Private Sub lblDate61_Click(): ClickControl lblDate61: End Sub
  1461. Private Sub lblDate62_Click(): ClickControl lblDate62: End Sub
  1462. Private Sub lblDate63_Click(): ClickControl lblDate63: End Sub
  1463. Private Sub lblDate64_Click(): ClickControl lblDate64: End Sub
  1464. Private Sub lblDate65_Click(): ClickControl lblDate65: End Sub
  1465. Private Sub lblDate66_Click(): ClickControl lblDate66: End Sub
  1466. Private Sub lblDate67_Click(): ClickControl lblDate67: End Sub
  1467.  
  1468.  
  1469. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1470. ' The following subs all call the HoverControl sub, passing the background of the date
  1471. ' label that has been hovered over.
  1472. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1473. 'User hovered over the date background
  1474. Private Sub bgDate11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate11: End Sub
  1475. Private Sub bgDate12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate12: End Sub
  1476. Private Sub bgDate13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate13: End Sub
  1477. Private Sub bgDate14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate14: End Sub
  1478. Private Sub bgDate15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate15: End Sub
  1479. Private Sub bgDate16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate16: End Sub
  1480. Private Sub bgDate17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate17: End Sub
  1481. Private Sub bgDate21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate21: End Sub
  1482. Private Sub bgDate22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate22: End Sub
  1483. Private Sub bgDate23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate23: End Sub
  1484. Private Sub bgDate24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate24: End Sub
  1485. Private Sub bgDate25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate25: End Sub
  1486. Private Sub bgDate26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate26: End Sub
  1487. Private Sub bgDate27_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate27: End Sub
  1488. Private Sub bgDate31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate31: End Sub
  1489. Private Sub bgDate32_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate32: End Sub
  1490. Private Sub bgDate33_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate33: End Sub
  1491. Private Sub bgDate34_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate34: End Sub
  1492. Private Sub bgDate35_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate35: End Sub
  1493. Private Sub bgDate36_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate36: End Sub
  1494. Private Sub bgDate37_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate37: End Sub
  1495. Private Sub bgDate41_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate41: End Sub
  1496. Private Sub bgDate42_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate42: End Sub
  1497. Private Sub bgDate43_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate43: End Sub
  1498. Private Sub bgDate44_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate44: End Sub
  1499. Private Sub bgDate45_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate45: End Sub
  1500. Private Sub bgDate46_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate46: End Sub
  1501. Private Sub bgDate47_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate47: End Sub
  1502. Private Sub bgDate51_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate51: End Sub
  1503. Private Sub bgDate52_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate52: End Sub
  1504. Private Sub bgDate53_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate53: End Sub
  1505. Private Sub bgDate54_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate54: End Sub
  1506. Private Sub bgDate55_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate55: End Sub
  1507. Private Sub bgDate56_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate56: End Sub
  1508. Private Sub bgDate57_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate57: End Sub
  1509. Private Sub bgDate61_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate61: End Sub
  1510. Private Sub bgDate62_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate62: End Sub
  1511. Private Sub bgDate63_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate63: End Sub
  1512. Private Sub bgDate64_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate64: End Sub
  1513. Private Sub bgDate65_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate65: End Sub
  1514. Private Sub bgDate66_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate66: End Sub
  1515. Private Sub bgDate67_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate67: End Sub
  1516. 'User hovered over the actual date label
  1517. Private Sub lblDate11_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate11: End Sub
  1518. Private Sub lblDate12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate12: End Sub
  1519. Private Sub lblDate13_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate13: End Sub
  1520. Private Sub lblDate14_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate14: End Sub
  1521. Private Sub lblDate15_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate15: End Sub
  1522. Private Sub lblDate16_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate16: End Sub
  1523. Private Sub lblDate17_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate17: End Sub
  1524. Private Sub lblDate21_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate21: End Sub
  1525. Private Sub lblDate22_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate22: End Sub
  1526. Private Sub lblDate23_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate23: End Sub
  1527. Private Sub lblDate24_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate24: End Sub
  1528. Private Sub lblDate25_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate25: End Sub
  1529. Private Sub lblDate26_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate26: End Sub
  1530. Private Sub lblDate27_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate27: End Sub
  1531. Private Sub lblDate31_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate31: End Sub
  1532. Private Sub lblDate32_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate32: End Sub
  1533. Private Sub lblDate33_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate33: End Sub
  1534. Private Sub lblDate34_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate34: End Sub
  1535. Private Sub lblDate35_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate35: End Sub
  1536. Private Sub lblDate36_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate36: End Sub
  1537. Private Sub lblDate37_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate37: End Sub
  1538. Private Sub lblDate41_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate41: End Sub
  1539. Private Sub lblDate42_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate42: End Sub
  1540. Private Sub lblDate43_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate43: End Sub
  1541. Private Sub lblDate44_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate44: End Sub
  1542. Private Sub lblDate45_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate45: End Sub
  1543. Private Sub lblDate46_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate46: End Sub
  1544. Private Sub lblDate47_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate47: End Sub
  1545. Private Sub lblDate51_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate51: End Sub
  1546. Private Sub lblDate52_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate52: End Sub
  1547. Private Sub lblDate53_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate53: End Sub
  1548. Private Sub lblDate54_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate54: End Sub
  1549. Private Sub lblDate55_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate55: End Sub
  1550. Private Sub lblDate56_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate56: End Sub
  1551. Private Sub lblDate57_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate57: End Sub
  1552. Private Sub lblDate61_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate61: End Sub
  1553. Private Sub lblDate62_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate62: End Sub
  1554. Private Sub lblDate63_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate63: End Sub
  1555. Private Sub lblDate64_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate64: End Sub
  1556. Private Sub lblDate65_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate65: End Sub
  1557. Private Sub lblDate66_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate66: End Sub
  1558. Private Sub lblDate67_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single): HoverControl bgDate67: End Sub
  1559.  
  1560.  
  1561. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1562. ' UserForm_MouseMove / frameCalendar_MouseMove / bgDayLabels_MouseMove
  1563. '
  1564. ' These three subs restore the last hovered date label to its original color when user is
  1565. ' no longer hovering over any date labels.
  1566. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1567. Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  1568.     If HoverControlName <> vbNullString Then
  1569.         Me.Controls(HoverControlName).BackColor = HoverControlColor
  1570.     End If
  1571. End Sub
  1572. Private Sub frameCalendar_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  1573.     If HoverControlName <> vbNullString Then
  1574.         Me.Controls(HoverControlName).BackColor = HoverControlColor
  1575.     End If
  1576. End Sub
  1577. Private Sub bgDayLabels_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  1578.     If HoverControlName <> vbNullString Then
  1579.         Me.Controls(HoverControlName).BackColor = HoverControlColor
  1580.     End If
  1581. End Sub
  1582.  
  1583.  
  1584. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1585. ' Known Bugs
  1586. '
  1587. ' -If today button falls outside of years in combobox, it is possible for it to add years
  1588. '   to the combobox out of order. IE if combobox holds 2016-2026 and user clicks 'Today'
  1589. '   in 2014, combobox could then hold 2014, 2016, 2017, etc...
  1590. ' -December 9999 generates an error when trying to calculate last day of month,  because
  1591. '   January 10000 is not a valid date in Excel
  1592. ' -Occasionally, the month or year label is truncated. Cannot reproduce consistently
  1593. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1594.  
  1595.  
  1596. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1597. ' Changelog
  1598. '
  1599. ' v1.5.2
  1600. ' -Bug fix: Userform not sizing properly in Word 2013
  1601. ' -Bug fix: Minimum font size not being preserved correctly
  1602. ' -Bug fix: Replaced WorksheetFunction.Max with custom Max function for compatibility
  1603. '   with other Office programs
  1604. '
  1605. ' v1.5.1
  1606. ' -Move all initialization code from GetDate and SetUserformSize to InitializeUserform
  1607. ' -Fully qualify "Control" declarations as "MSForms.Control" for compatibility with Access
  1608. ' -Bug fix: Eliminated FindLastDayOfMonth function, which contained a leap year bug
  1609. ' -Bug fix: Calendar frame not setting background color correctly
  1610. ' -Bug fix: Hover over calendar frame clears hovered control
  1611. '
  1612. ' v1.5.0
  1613. ' -Added a frame around all calendar elements. Calendar now positions and sizes itself
  1614. '   relative to its frame, rather than the userform as a whole. This way, the frame
  1615. '   can be placed anywhere within a larger userform to use it as an embedded calendar
  1616. '   rather than a popup. If you size the userform larger than the calendar, it will
  1617. '   remain that size, so you can add other controls.
  1618. '
  1619. ' v1.4.0
  1620. ' -Initial public release
  1621. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1622.  
  1623.  
  1624. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1625. ' Future enhancements
  1626. '
  1627. ' -Calculate all userform colors off one color argument, to reduce the wall of
  1628. '   arguments in GetDate function
  1629. ' -Combine DateBorder and DateSpecialEffect arguments to one enumeration, since they
  1630. '   cancel eachother out
  1631. ' -Remove userform toolbar (credit: Flemming Vadet, fv@smartoffice.dk, www.smartoffice.dk)
  1632. ' -Remove extra row of trailing dates for months that have only 5 rows of dates, making
  1633. '   sure to handle special case of months with 4 rows, like Feb 2015 (credit: Greg Maxey,
  1634. '   gmaxey@mvps.org, gregmaxey.mvps.org/word_tips.htm)
  1635. ' -Today button selects date and closes if Okay disabled
  1636. ' -Add Cancel button
  1637. ' -Better diferrentiation between disabled dates and trailing month dates (credit: Greg
  1638. '   Maxey, gmaxey@mvps.org, gregmaxey.mvps.org/word_tips.htm)
  1639. ' -Move selected day calculation to SetDays function only, to avoid having to
  1640. '   redundantly calculate it in so many different functions
  1641. ' -Add option to hide weekends (credit: Don Gray, don@rania.co.uk, www.rania.co.uk/ST)
  1642. ' -Change cursor when hovering selectable controls
  1643. ' -Month/Year in header change color on hover
  1644. ' -Change buttons to flat labels w/ icons
  1645. ' -Add tooltip when hovering over a date
  1646. ' -Add worksheet to explain how to import/export userform
  1647. ' -Add documentation explaining how to use with different date formats
  1648. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  1649.  
  1650.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement