Calendrier (Date Picker)

Le 02/12/2016 à 22:12

Bonsoir à tous,

J'utilise le petit calendrier (add-ins) ci-joint qui fonctionne très bien...

Il y a juste un détail que j'aimerais bien modifier mais après de nombreuses tentatives qui ont échouées,

je me résigne a demander de l'aide !!!

Explication:

Quand on ouvre le calendrier, la date du jour est en rouge et en Gras.

Dès que l'on change de mois ou d'année, et que l'on revient à la date du jour, la date du jour est maintenant en noir...

Question:

Comment faire pour que même si l'on change de mois ou d'année, la date du jour reste en rouge et en Gras ?

Voilà, c'est tout !

208windatepicker.xlam (62.97 Ko)
Le 03/12/2016 à 09:15

Bonjour,

Remplace la sub "UpdateDisplay" par celle-ci :

Sub UpdateDisplay(Y, m)
    Dim FirstDay As Long, DaysInMonth As Long, LastDay As Long
    Dim I As Long, w As Long

    If Me.OptionButtonISO.Value = True Or Me.OptionButtonMonday.Value = True Then
        FirstDay = Weekday(DateSerial(Y, m, 1), 2)
        Me.week.Caption = "Sem." 'ThisWorkbook.Sheets(2).Cells(7, ComboLanguage.ListIndex + 1).Value
        Me.day1.Caption = "Lun." 'Left(ThisWorkbook.Sheets(1).Range("B2").Text, 1)
        Me.day2.Caption = "Mar." 'Left(ThisWorkbook.Sheets(1).Range("B3").Text, 1)
        Me.day3.Caption = "Mer." 'Left(ThisWorkbook.Sheets(1).Range("B4").Text, 1)
        Me.day4.Caption = "Jeu." 'Left(ThisWorkbook.Sheets(1).Range("B5").Text, 1)
        Me.day5.Caption = "Ven." 'Left(ThisWorkbook.Sheets(1).Range("B6").Text, 1)
        Me.day6.Caption = "Sam." 'Left(ThisWorkbook.Sheets(1).Range("B7").Text, 1)
        Me.day7.Caption = "Dim." 'Left(ThisWorkbook.Sheets(1).Range("B8").Text, 1)
    Else
        FirstDay = Weekday(DateSerial(Y, m, 1), 1)
        Me.week.Caption = "Sem." 'ThisWorkbook.Sheets(2).Cells(7, ComboLanguage.ListIndex + 1).Value
        Me.day1.Caption = "Lun." 'Left(ThisWorkbook.Sheets(1).Range("B1").Text, 1)
        Me.day2.Caption = "Mar." 'Left(ThisWorkbook.Sheets(1).Range("B2").Text, 1)
        Me.day3.Caption = "Mer." 'Left(ThisWorkbook.Sheets(1).Range("B3").Text, 1)
        Me.day4.Caption = "Jeu." 'Left(ThisWorkbook.Sheets(1).Range("B4").Text, 1)
        Me.day5.Caption = "Ven." 'Left(ThisWorkbook.Sheets(1).Range("B5").Text, 1)
        Me.day6.Caption = "Sam." 'Left(ThisWorkbook.Sheets(1).Range("B6").Text, 1)
        Me.day7.Caption = "Dim." 'Left(ThisWorkbook.Sheets(1).Range("B7").Text, 1)
    End If

    DaysInMonth = Day(DateSerial(Y, m + 1, 0))
    LastDay = DaysInMonth + FirstDay - 1

    For I = 1 To 42
        Controls("label" & Format(I, "00")).Caption = ""
        If I >= FirstDay And I <= LastDay Then
            Controls("label" & Format(I, "00")).Caption = I - FirstDay + 1
            Controls("Label" & Format(I, "00")).ForeColor = vbBlack
            Controls("Label" & Format(I, "00")).Font.Bold = False
        End If

    Next I

    For w = 1 To 36 Step 7
        If Controls("Label" & Format(w, "00")).Caption <> "" Or Controls("Label" & Format(w + 6, "00")).Caption <> "" Then

            If Controls("Label" & Format(w, "00")).Caption <> "" Then

                If Me.OptionButtonISO.Value = True Then
                    Controls("w" & Format(w, "00")).Caption = IsoWeekNumber(DateSerial(YearSpinner.Value, MonthSpinner.Value, Controls("Label" & Format(w, "00")).Caption))
                End If

                If Me.OptionButtonSunday.Value = True Then
                    Controls("w" & Format(w, "00")).Caption = VBAWeekNum(DateSerial(YearSpinner.Value, MonthSpinner.Value, Controls("Label" & Format(w, "00")).Caption), 1)
                End If

                If Me.OptionButtonMonday.Value = True Then
                    Controls("w" & Format(w, "00")).Caption = VBAWeekNum(DateSerial(YearSpinner.Value, MonthSpinner.Value, Controls("Label" & Format(w, "00")).Caption), 2)
                End If
            Else
                If Me.OptionButtonISO.Value = True Then
                    Controls("w" & Format(w, "00")).Caption = IsoWeekNumber(DateSerial(YearSpinner.Value, MonthSpinner.Value, Controls("Label" & Format(w + 6, "00")).Caption))
                End If

                If Me.OptionButtonSunday.Value = True Then
                    Controls("w" & Format(w, "00")).Caption = VBAWeekNum(DateSerial(YearSpinner.Value, MonthSpinner.Value, Controls("Label" & Format(w + 6, "00")).Caption), 1)
                End If

                If Me.OptionButtonMonday.Value = True Then
                    Controls("w" & Format(w, "00")).Caption = VBAWeekNum(DateSerial(YearSpinner.Value, MonthSpinner.Value, Controls("Label" & Format(w + 6, "00")).Caption), 2)
                End If
            End If

        Else
            Controls("w" & Format(w, "00")).Caption = ""
        End If
    Next w

    For I = 1 To 42

        If Controls("Label" & Format(I, "00")).Caption = CStr(Day(Now())) And _
            YearSpinner.Value = Year(Now()) And _
            MonthSpinner.Value = Month(Now()) Then

            Controls("Label" & Format(I, "00")).ForeColor = vbRed
            Controls("Label" & Format(I, "00")).Font.Bold = True

        End If

    Next I

End Sub
Le 03/12/2016 à 12:07

Merci Theze...

Cela fonctionne a merveille !!!

Je passe en résolu...

Rechercher des sujets similaires à "calendrier date picker"