1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
| ' Si la notification correspond à un changement de la date
If lnmhdr.code = MCN_SELCHANGE Then
' Ajout test
' Récupère l'intervalle de date sélectionné sur le calendrier
If SendMessage(shwnd, MCM_GETSELRANGE, 0&, lSystemTimeRange(0)) <> 0 Then
' Date de début de sélection
lCalcDate = DateSerial(lSystemTimeRange(0).wYear, lSystemTimeRange(0).wMonth, lSystemTimeRange(0).wDay)
' Date du lundi
lCalcDate = lCalcDate - Weekday(lCalcDate, vbMonday) + 1
' Première date en format systemtime
lSystemTimeRange(0).wYear = Year(lCalcDate): lSystemTimeRange(0).wMonth = Month(lCalcDate): lSystemTimeRange(0).wDay = Day(lCalcDate)
' Ajout 6 jours pour atteindre le dimanche
lCalcDate = lCalcDate + 6
' Deuxième date en format systemtime
lSystemTimeRange(1).wYear = Year(lCalcDate): lSystemTimeRange(1).wMonth = Month(lCalcDate): lSystemTimeRange(1).wDay = Day(lCalcDate)
' Sélectionne la semaine complète dans le calendrier
Call SendMessage(shwnd, MCM_SETSELRANGE, 0&, lSystemTimeRange(0))
' Formate le résultat
lDate = Format(DateSerial(lSystemTimeRange(0).wYear, lSystemTimeRange(0).wMonth, lSystemTimeRange(0).wDay), "Short Date") _
& "-" & Format(DateSerial(lSystemTimeRange(1).wYear, lSystemTimeRange(1).wMonth, lSystemTimeRange(1).wDay), "Short Date")
' Met à jour la zone de texte
Call SendMessage(sEditHwnd, WM_SETTEXT, _
Len(lDate), ByVal lDate)
Else ' Si MCM_GETSELRANGE ne fonctionne pas, la sélection est unitaire
' Récupère la date sélectionnée sur le calendrier
SendMessage shwnd, MCM_GETCURSEL, 0&, lSystemTime
' Formate la date
lDate = Format(DateSerial(lSystemTime.wYear, lSystemTime.wMonth, lSystemTime.wDay), "Short Date")
' Met à jour la zone de texte
Call SendMessage(sEditHwnd, WM_SETTEXT, _
Len(lDate), ByVal lDate)
End If
End If |
Partager