• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Ribbon DatePicker Calendar Control For Excel 2007-2010

Sam Mathai Chacko

Active Member
So here's something that I did for fun some time back. My original work just had 3 rows for all the days of a month. I thought a gallery would be much better than a button. Brushed up some bits here and there. Feel free to give any feedback or suggestion.

Apart from the feeling of sharing, another reason why I post it here is also for someone from a non-English Office environment to test whether there's any problem with my assumption that the calendar week starts from Sunday (I suspect there might).

By the way, this will only show the dates for the selected month.. leaving a few of the beginning and ending slots empty, rather than have the days of the previous and next months also as you'd normally find in the DatePicker control that Office provides. Sorry for that, but I couldn't find a way to format the slots, so just left it empty for ease.
 

Attachments

SirJB7

Excel Rōnin
Hi, Sam Mathai Chacko!

Nice stuff, thanks for sharing, yet put into my magic pocket :)

In a Spanish (non-English) OS & Office environment I noticed these points.
a) Month names are displayed in local language
b) Day name's abbreviations at the top of monthly calendar are displayed in English
c) Icon displays always "Day"
d) Changed my starting day from Sunday to Monday and calendar still started on Sunday

Regards!

PS: My magic pocket is a subfolder of Chandoo.org folder named "0 - Cool", just fyi.
PS: Don't make any association with any movie of the middle 90's... but what jolie that was Acid Burn, French dixit ;)
 

Sam Mathai Chacko

Active Member
Hi SirJB7!

Thanks for the compliment and the feedback. Let me see how much I can rectify.

by points a) and b), I assume you mean to say that the language should be consistent. If it's showing in local language, then everything should be in local language. But if in English, then everything in English. Right?

for c), what do you suggest I do? Should I just leave it blank? Or use the local language word for Day?

and d) is something that I think I have a solution for. But just to be sure, when you say you changed your starting day from Sun to Mon, did you mean that you changed to constant string "Su|Mo|....|Sa" to "Mo|Tu|....|Su"?
 

SirJB7

Excel Rōnin
HI, Sam Mathai Chacko!

First of all, all your assumptions were correct. Points a) & b), as you said; c), last option, use the local language for Day; d), exactly, "Mo|Tu|....|Su". Sorry for not having answered yet but sometimes I'm powered off as much as possible, not only from computers & internet but from the world if I can.

Thank you very much for the modifications. Please check in the uploaded image how does it work with another language version:
- top left: normal appearance (*)
- top right: drop down for month selection (Ok, local language)
- bottom left: drop down for day selection (Ok, local language, default week starting on Sunday - Domingo)
- bottom right: drop down for day selection (Ok, local language, starting week changed to Monday - Lunes)

(*) Just for being purist, it'd be wonderful if the words Day and Calendar should adopt the localized names.

Regards!

PS: Nothing related to this topic, but just talking about languages and localizations I remebered this, and maybe you want to give a look at it:
http://chandoo.org/forum/threads/excel-multilanguage-formula-translator-and-function-reference.4789
 

Attachments

Sam Mathai Chacko

Active Member
Alright, I've tried to incorporate as much as I thought would add value. Thanks to SirJB7 for the valuable inputs. I must confess I couldn't come around a very reliable and easy way to display the words 'Day' and 'Calendar' in local languages. Having said that, I've given options to the users to go to the code and hard code those two words in their local languages. The two routines you need to look for are as below

Code:
'Callback for grpCalendar getLabel
Sub GetLabelCalendarGroup(control As IRibbonControl, ByRef returnedVal)
'I've decided to leave this open for any other developer who would like to use a translator or any other mechanism,
'to give a local language name for the calendar. You could either hard-code it below, or use any reliable method to,
'get proper local language translation
    returnedVal = "Calendar"
End Sub
And

Code:
'Callback for galCalendar getLabel
Sub GetLabelDay(control As IRibbonControl, ByRef returnedVal)
    'If you want to provide any label (caption) for the date selection gallery, you can pass that value here
    'Note the some special characters are not accepted
    'I've decided to leave this open for any other developer who would like to use a translator or any other mechanism,
    'to give a local language name for 'Day'. You could either hard-code it below, or use any reliable method to,
    'get proper local language translation
    returnedVal = "Day"
End Sub
In addition, the new date-picker now looks like this. I hope you like the additional features to move beyond a window of 50 years (I must confess, I didn't test the tool for anything before 1900, primarily because I know it will not work, and secondly, because I'm too lazy to put in more work on this).
Ribbon Calendar Revised.png

Well, I leave it to your safe hands gentlemen (and ladies). If you come up with anything that can really improve this, you are more than welcome. :)
 

Attachments

Sam Mathai Chacko

Active Member
Hi All

Wasn't able to spend time on the forum over the last couple of weeks as I was busy with client visits at work, and had to focus attention there at work.

Anyway, a good man, Neil Holder, an Excel enthusiast like most of us, has given a valuable insight about the Ribbon Date-picker I developed. He suggested that when the add-in is run in Excel 64 bit version run on Win 7 64 bit, some of the functions like MonthName returns an error because we are passing the month index argument as a LongPtr, rather than a Long variable. Because of that, in such cases, the add-in will not work. He suggested that an easy workaround would be to convert the LongPtr variables to Long using the CLng function. I guess the whole issue is because the inbuilt functions are not designed to alter the argument types that need to passed when they are in all 32 bit or all 64 bit combinations of Excel and Windows. If my assumption is flawed, please feel free to give more clarity or correction.

Attaching the revised file, as well as the revised code.

Code:
Option Explicit
'===========================================================================================
'Design and development by Sam Mathai Chacko
'An idea remains an idea until it is implemented
'Due credit to Neil Holder
'===========================================================================================
'And this is where we have dimensioned our module variables
'This is our ribbon control variable
Dim miruCalendar As IRibbonUI
'The following constant can be used to define the starting day of the week
'So one can use the enumerated type members of the VbDayOfWeek class to pass value to this constant
'The values can be vbSunday, vbMonday,......vbSaturday (I am using vbUseSystemDayOfWeek because I like to go with default)
Private Const mcbytDayOfWeek As Byte = vbUseSystemDayOfWeek
'Changing this value will allow you to specific the big increment/decrement for years
Private Const mclngBigYearIncrementDecrement As Long = 10
Private Const mclngYearWindowFromSelectedYear As Long = 50
'I'm just trying to be generous with the 64-bit users.
'Why check for VB 7 environment if it's already a 64 bit environment, right? Yeah, I get that all the time. Go figure.
'If you are a 'Winchester-Waco-Johnny-Dean-developer', you should look at this
'http://social.msdn.microsoft.com/Forums/office/en-US/999c5d69-a176-43e5-b5df-716f8960fc6e/my-code-if-else-for-64-bit-is-not-being-recognized
#If VBA7 Then
    #If Win64 Then
        Dim lngStartDay             As LongPtr, _
            lngEndDay               As LongPtr, _
            lngDayCount             As LongPtr, _
            lngDaySlotCount         As LongPtr, _
            lngSelectedYear         As LongPtr, _
            lngSelectedMonth        As LongPtr, _
            lngMonthDays(0 To 48)   As LongPtr
    #Else
        Dim lngStartDay             As Long, _
            lngEndDay               As Long, _
            lngDayCount             As Long, _
            lngDaySlotCount         As Long, _
            lngSelectedYear         As Long, _
            lngSelectedMonth        As Long, _
            lngMonthDays(0 To 48)   As Long
    #End If
#Else 'Yes, it seems like a paradox, but who knows, what if it's 64 bit and still VB6
    Dim lngStartDay             As Long, _
        lngEndDay               As Long, _
        lngDayCount             As Long, _
        lngDaySlotCount         As Long, _
        lngSelectedYear         As Long, _
        lngSelectedMonth        As Long, _
        lngMonthDays(0 To 48)   As Long
#End If
'Callback for customUI.onLoad
Sub LoadCalendar(ribbon As IRibbonUI)
    
    'So this is the first callback that will run for the ribbonUI, ie, the OnLoad function
    'We use an IRibbonUI control to set the object
    Set miruCalendar = ribbon
    'We also initialize our calendar control for the current year and date (so this is what the user will see by default)
    lngSelectedYear = Year(Date)
    lngSelectedMonth = Month(Date)
    
End Sub

'Callback for grpCalendar getLabel
Sub GetLabelCalendarGroup(control As IRibbonControl, ByRef returnedVal)
'I've decided to leave this open for any other developer who would like to use a translator or any other mechanism,
'to give a local language name for the calendar. You could either hard-code it below, or use any reliable method to,
'get proper local language translation
    returnedVal = "Calendar"
End Sub

'Callback for galCalendar getEnabled
Sub GetEnabled(control As IRibbonControl, ByRef returnedVal)
    'Of course we want our calendar to be enabled
    'Having said that we could have avoided using the getEnabled feature, and just used enabled="true" in the XML
    returnedVal = True
End Sub
'Callback for galCalendar getLabel
Sub GetLabelDay(control As IRibbonControl, ByRef returnedVal)
    'If you want to provide any label (caption) for the date selection gallery, you can pass that value here
    'Note the some special characters are not accepted
    'I've decided to leave this open for any other developer who would like to use a translator or any other mechanism,
    'to give a local language name for 'Day'. You could either hard-code it below, or use any reliable method to,
    'get proper local language translation
    returnedVal = "Day"
End Sub
'Callback for galCalendar getItemCount
Sub GetItemCount(control As IRibbonControl, ByRef returnedVal)
    'I use 49 because that's what all the normal date calendars use. After the top row is used for the name of the 7 days, 42 remains.
    'So 42 is basically 7 days * 6 rows
    'The first row will be used to display week days Monday to Sunday
    'The next 6 rows will be used to display the dates depending on where the first date for the corresponding month starts from
    'For example, if we selected a non-leap year february, with the first day starting on a Monday, we would end up using only 4 rows
    'and the remaining 1 row will be entirely blank
    'Similarly, there will be months which start on a Sunday, which is the last column of our calendar control,
    'effectively using at 1 or 2 columns of the last row, depending on whether there are 30 or 31 days for that month
    returnedVal = 49
End Sub

'Callback for galCalendar getItemLabel
Sub GetItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
    'So this is where all the action happens (well, at least most of it)
    'So first of all, we need the top row to have the names of the week
    'Of course it is up to the developer to decide on any algorithm to come up with the names of the weekdays
    'Based on feedback from some non-English office users,
    'I've decided to use the WeekDayName function to return the correct Weekday name depending on which day their week starts
    'We now need to identify the weekday on which the first day of the month starts
    lngStartDay = Weekday(DateSerial(CInt(lngSelectedYear), CInt(lngSelectedMonth), 1), mcbytDayOfWeek) 'Year(Date), Month(Date), 1))
    'We also need to know how many days there are in that month
    lngEndDay = Day(DateSerial(CInt(lngSelectedYear), CInt(lngSelectedMonth) + 1, 0)) 'DateSerial(Year(Date), Month(Date) + 1, 0))
    'Now we use a select case to distinquish between the top row of our calendar, and the remaining rows
    'As you know, we have 7 columns. But what we need to be aware of is that the index parameter passed by this function starts from zero (0)
    'So in my select case, I used < 7 instead of <= 7
    Select Case index < 7
        Case True 'Of course you know what this means
            'Here we just pass back the name of each of the 7 weekdays as labels (yeah that's right, labels. Isn't that what the function name suggests?).
            'In other words, you can consider labels as a caption (you know, like for a commandbutton, or a userform. OK, you got the idea)
            returnedVal = Left(WeekdayName(index + 1, True, mcbytDayOfWeek), 2) 'This is where we pass the name of the weekday as a label for the control
        Case Else 'Now, here's where the date part begins (because this is after the first 7 controls (or the top most row of our calendar)
            'You remember we had already captured the weekday on which the first day of the month starts
            'We also know how many days there are in the month
            'Now we need to keep track of how many controls we are iterating through. For that I simply use a variable and increment it
            'Note that the variables I am using have module scope (to know about scope of variables, visit http://support.microsoft.com/kb/141693)
            lngDaySlotCount = lngDaySlotCount + 1
            'So now we need to know when to start passing the days as labels
            'For that I'm also using another module variable to increment the days and check if the days haven't exceeded the maximum days in that month
            If lngDaySlotCount >= lngStartDay And lngDayCount < lngEndDay Then
                lngDayCount = lngDayCount + 1 'This is the day increment variable
                lngMonthDays(index) = lngDayCount 'This is an array of 49 items (0 to 48) where I keep track of the current months days. Will explain why I used this where I am using this
                returnedVal = lngDayCount 'This is where we pass the day as a label for the control
            End If
    End Select
    
End Sub
Remainder to follow...
 

Attachments

Sam Mathai Chacko

Active Member
Code:
'Callback for galCalendar onAction
Sub galleryOnAction(control As IRibbonControl, id As String, index As Integer)
    'This is where we pass the value of the selected date, on to the sheet
    'Of course this will only pass value to the active cell. So if you've selected a range of cells, still the value will only be passed to the active cell
    'Using as On Error Resume Next statement just to ensure we don't loose the ribbon control due to unwanted errors (for example, if no workbook is active, then there wouldn't be an active cell, would there?)
    On Error Resume Next
    'Now, in the GetItemLabel callback that I used above, I am using an array that I use as a container for the labels of the 42 (49 - 7 top row) button items
    'I had mentioned that I'll explain it's usage later. Well, this is where I am using it.
    'To pass the value of the selected date, I am using the DateSerial function.
    'Now, we already know (or we will know) the selected year and the selected month
    'But that is not enough to pass the date. Yes, we need the day also. But we only know the index of the control that we pressed on
    'But since we have the values of the 42 items in the array, exactly in order of placement on the ribbon, we just need to refer to the value using the index we get as argument to this function
    'Oh and since some of the slots in the first row and the last row may be empty, we just need to check that before we actually pass the value
    If lngMonthDays(index) Then
        'So if lngMonthDays(index) is not zero, then it means it's a valid date for the selected month and year
        'And we pass that to the active cell
        ActiveCell.Value = DateSerial(CInt(lngSelectedYear), CInt(lngSelectedMonth), CInt(lngMonthDays(index)))
    Else
        'If lngMonthDays(index) is zero, then we just assume that the user clicked on the item by mistake and we just clear the activecell value
        'Of course we could just not do anything at all. But I thought what the heck, let the user have an extra reason to not be casual
        'If you want to be more empathetic (or sympathetic), just remove the line below)
        ActiveCell.ClearContents
    End If
End Sub

'Callback for galYear getItemLabel
Sub GetItemLabelYear(control As IRibbonControl, index As Integer, ByRef returnedVal)
    'I probably am one of the most laziest person when it comes to programming.
    'So I just hard coded the year selection option to a window of mclngYearWindowFromSelectedYear * 2 years (ie, mclngYearWindowFromSelectedYear before and after current year)
    'And since index starts from 0, you can make out what the following line passes as returnedVal
    returnedVal = Year(Date) - mclngYearWindowFromSelectedYear + index
End Sub

'Callback for galYear getItemCount
Sub GetItemCountYear(control As IRibbonControl, ByRef returnedVal)
    'OK, so this is where I tell the ribbon that it should only have X * 2 items in the year selection gallery
    returnedVal = mclngYearWindowFromSelectedYear * 2
End Sub
'Callback for galYear getLabel
Sub GetLabelYear(control As IRibbonControl, ByRef returnedVal)
    'So whenever we need to pass a label (caption) to the year gallery, this is the function we use
    'You will remember that we are passing the current year to lngSelectedYear when the ribbon is loaded
    'But you'll also notice in one of the functions below that we are passing the user selected year also to this variable
    'That's where we keep the label dynamic (look at galleryOnActionYear function)
    returnedVal = lngSelectedYear
End Sub

'Callback for btnMonthDecrement onAction
Sub MonthDecrement(control As IRibbonControl)
    If lngSelectedMonth = 1 Then
        lngSelectedMonth = 13
        lngSelectedYear = lngSelectedYear - 1
    End If
    lngSelectedMonth = lngSelectedMonth - 1
    YearMonthChange
End Sub

'Callback for galMonth getLabel
Sub GetLabelMonth(control As IRibbonControl, ByRef returnedVal)
    'So everybody who knows the MonthName fuction will know what this does. Those who don't just hit F1
    returnedVal = MonthName(CLng(lngSelectedMonth), True)
End Sub

'Callback for btnMonthIncrement onAction
Sub MonthIncrement(control As IRibbonControl)

    If lngSelectedMonth = 12 Then
        lngSelectedMonth = 0
        lngSelectedYear = lngSelectedYear + 1
    End If
    lngSelectedMonth = lngSelectedMonth + 1
    YearMonthChange
    
End Sub


'Callback for galMonth getItemLabel
Sub GetItemLabelMonth(control As IRibbonControl, index As Integer, ByRef returnedVal)
    'You should be able to figure this one out by now. It follows the same principles as the GetItemLabelYear callback function
    returnedVal = MonthName(index + 1, True)
End Sub

'Callback for galMonth getItemCount
Sub GetItemCountMonth(control As IRibbonControl, ByRef returnedVal)
    'Same logic as above
    returnedVal = 12
End Sub

'Callback for galMonth onAction
Sub galleryOnActionMonth(control As IRibbonControl, id As String, index As Integer)
    'Index starts from 0. So if the user clicks to first item, we are supposed to get 1, not zero, so index + 1
    lngSelectedMonth = index + 1
    'Same logic as above
    YearMonthChange
End Sub

'Callback for btnYearBigDecrement onAction
Sub YearBigDecrement(control As IRibbonControl)
    'This will decrement the selected year by X (as defined by the constant mclngBigYearIncrementDecrement
    lngSelectedYear = lngSelectedYear - mclngBigYearIncrementDecrement
    'Calling the invalidation and clean-up routine whenever a year/month changes
    YearMonthChange
End Sub

'Callback for btnYearSmallDecrement onAction
Sub YearSmallDecrement(control As IRibbonControl)
'This will decrement the selected year by 1
    lngSelectedYear = lngSelectedYear - 1
    'Calling the invalidation and clean-up routine whenever a year/month changes
    YearMonthChange
End Sub

'Callback for galYear onAction
Sub galleryOnActionYear(control As IRibbonControl, id As String, index As Integer)
    'So here's where we convert the index value we receive when this function is invoked, in to the year which the user intended to select
    'Don't mind the word 'invoked'. It just meant 'called by the user by clicking on any of the mclngYearWindowFromSelectedYear * 2 years'
    lngSelectedYear = Year(Date) - mclngYearWindowFromSelectedYear + index
    'Here we do some cleaning and invalidation. Invalidating a control (or a ribbon) is like using the '.Dirty' function of a range object
    'It's like asking the control to validate itself again, cause we told it to do so ;)
    Call YearMonthChange
End Sub

'Callback for btnYearSmallIncrement onAction
Sub YearSmallIncrement(control As IRibbonControl)
    'This will increment the selected year by 1
    lngSelectedYear = lngSelectedYear + 1
    'Calling the invalidation and clean-up routine whenever a year/month changes
    YearMonthChange
End Sub

'Callback for btnYearBigIncrement onAction
Sub YearBigIncrement(control As IRibbonControl)
    'This will increment the selected year by X (as defined by the constant mclngBigYearIncrementDecrement
    lngSelectedYear = lngSelectedYear + mclngBigYearIncrementDecrement
    'Calling the invalidation and clean-up routine whenever a year/month changes
    YearMonthChange
End Sub
Sub YearMonthChange()
    
    'So we are invalidating the three controls (1)Day, (2)Year, (3)Month
    miruCalendar.InvalidateControl "galCalendar"
    miruCalendar.InvalidateControl "galYear"
    miruCalendar.InvalidateControl "galMonth"
    'We are also resetting our Day and DaySlot counters to empty
    lngDayCount = Empty
    lngDaySlotCount = Empty
    'And since each month is different from each, we cannot hold the container constant
    'It's an array, and we need to clear it using the Erase function
    Erase lngMonthDays
    
End Sub
Hi bobhc,

Yes, I have seen the link. Thank you. It's cool.
 

Bob362

New Member
Hi Sam,

I have tried the "Ribbon calendar" macro on my system (Win8 x64, Office 2013 x64, French language). Everything is working nice. It's easy, clean and super fast!

Thank you so much for such a great work. I really appreciate it. And if you complete the missing sections... I will be pleased to try it.

Thank's again.

Bob
 

Bob362

New Member
Hi Sam,

While using Ribbon DatePicker Calendar Control with more than one worksheet opened, I ran into a little issue. This happens only when I switch worksheet back and forth or when I open a new worksheet. The problem is the calendar do not display the numbers of the date, they are there because if I click on one of them the right date goes into the cell. If I switch month or year the numbers come back and everything works fine until I change worksheet again. Otherwise things are OK.

Do you have any idea? I'm using Windows 8 and Excel 2013.

Thank you very much.

Bob
 

Attachments

Dexter1759

New Member
Wow, here I am just browsing the Chandoo forums (long time blog visitor, first time forum visitor) and see my name being credited by Sam...I'm famous! lol.

Whilst my calendar is no where near as complete and tested for different Excel versions as Sam's, it's had a couple of tweaks since. Mainly the following:
  • The ability to link a calendar to a cell, with two way synchronisation.
  • Date pre-sets for the two calendars.
My main annoyances that I can't seem to overcome, are:
  • Not being able to put the green arrows in the drop down, like a "proper" calendar. (without having the calendar close each time it's clicked)
  • Not being able to fix the widths and positions on the calendars so they align properly.
  • Ugly list for date pre-sets, I'd like this to work more elegantly, something I'll work on soon.
Below are some screenshots, if anyone has any tips/tricks to fixing the above that would be brilliant.
calendar.png
presets.png
 

Attachments

fabrizio

New Member
Hi all,
nice job.
it's 4 days that I try to use this control on Access Ribbon but I can right.
Someone allready try it??
 

fabrizio

New Member
Hi,
if somebody is interesting I find one solution at my problem.
I solved with this calendar: Calendar.
Into my ribbon I've one button and one editbox, the button open form.calendar and when i choice my date the editbox will be compiled.
The same code will be use into a Form.
Bye
 
Top