collection fausse boite de dialogue (Patricktoulon) episode 1 Le calendrier Modal

collection fausse boite de dialogue (Patricktoulon) episode 1 Le calendrier Modal 5.4

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

re
correction pour les num sem en double
changer la sub reloadclavier
VB:
'mise ajour du clavier
Public Sub ReloadClavier()
    Dim X&, I&, A&, NB_JOURS&, Y&, WkD&
    If Cbmonth.Value = "" Or Cbyear.Value = "" Then Exit Sub
    Select Case Calendar.region
    Case 0, 22: WkD = vbSunday
    Case 1, 2, 12, 13: WkD = vbMonday
    End Select
    X = Weekday(DateSerial(Calendar.Cbyear, Calendar.Cbmonth.ListIndex + 1, 1), WkD)
    NB_JOURS = Day(DateSerial(Cbyear.Value, Cbmonth.ListIndex + 2, 0))
    For I = 1 To 6: Me.Controls("sem" & I) = "": Next
    For I = 1 To 42
        With Calendar.Controls("j" & I)
            .Caption = "": .Enabled = False: .BackColor = bt2Back: .ControlTipText = ""
            If I >= X And A <= NB_JOURS - 1 Then
                .Visible = True: A = A + 1: .Enabled = True: .Caption = A: .BackColor = bt1Back
                Y = CLng(DateSerial(Calendar.Cbyear.Value, Calendar.Cbmonth.ListIndex + 1, A))
                Controls(.Tag).Caption = Evaluate("= TRUNC((" & Y & "-WEEKDAY(" & Y & ",2)+11-DATE(YEAR(" & Y & "-WEEKDAY(" & Y & " ,2)+4),1,1))/7)")
                .BackColor = férié(I)
            End If
            Dim j
            For j = 2 To 6
                If Calendar.Controls("j" & I).Enabled = True Then If Calendar.Controls("sem" & j).Caption = Calendar.Controls("sem" & j - 1).Caption Then Calendar.Controls("sem" & j).Caption = Val(Calendar.Controls("sem" & j).Caption) + 1
            Next
        End With
    Next
End Sub
bonne soirée
la correction est fonctionnelle mais ayant horreur des patchs de correction je corrigerais plus proprement plus tard
 
c'est quand même étonnant chez moi je n'ai pas besoin de la boucle pour patcher
W7 office 2013 pro plus
demo8.gif
 
Bonjour le Fil ,le Forum
Patrick
j'ai aussi ce problème
unique ment avec le Format US et QUEBEC,
Lorsque tu fais défiler les années si le dernier jour du Mois est le premier jour de la semaine y'a doublon !
Merci de ce que tu fais
Bonne journée
Amicalement
jean marie
 

Pièces jointes

  • PatrickCalendar_1.gif
    PatrickCalendar_1.gif
    558.5 KB · Affichages: 36
Bonjour @ChTi160 , @duplaly
et voila la correction définitive
j'appliquais pas le bon index pour weekday dans la formule il fallait le rendre dynamique
VB:
'mise ajour du clavier
Public Sub ReloadClavier()
    Dim X&, I&, A&, NB_JOURS&, Y&, WkD&, j&
    If Cbmonth.Value = "" Or Cbyear.Value = "" Then Exit Sub
    Select Case Calendar.region
    Case 0, 22: WkD = vbSunday: j = 1
    Case 1, 2, 12, 13: WkD = vbMonday: j = 2
    End Select
    X = Weekday(DateSerial(Calendar.Cbyear, Calendar.Cbmonth.ListIndex + 1, 1), WkD)
    NB_JOURS = Day(DateSerial(Cbyear.Value, Cbmonth.ListIndex + 2, 0))
    For I = 1 To 6: Me.Controls("sem" & I) = "": Next
    For I = 1 To 42
        With Calendar.Controls("j" & I)
            .Caption = "": .Enabled = False: .BackColor = bt2Back: .ControlTipText = ""
            If I >= X And A <= NB_JOURS - 1 Then
                .Visible = True: A = A + 1: .Enabled = True: .Caption = A: .BackColor = bt1Back
                Y = CLng(DateSerial(Calendar.Cbyear.Value, Calendar.Cbmonth.ListIndex + 1, A))
                Controls(.Tag).Caption = Evaluate("= TRUNC((" & Y & "-WEEKDAY(" & Y & "," & j & ")+11-DATE(YEAR(" & Y & "-WEEKDAY(" & Y & " ," & j & ")+4),1,1))/7)")
                .BackColor = férié(I)
            End If
        End With
    Next
End Sub
plus besoins de la boucle patch bien entendu 😉
c'est plus propre comme ça
 
Bonjour patrick, jean-marie, le fil,

Image.jpg


« 4.1.9 », c'est bien sûr la version de ton calendrier ; mais c'est quoi « Q-I-S-RU » ?
j'ai fait une recherche dans cette conversation sur « Q-I-S-RU », mais ça n'a rien
donné. 😕 (éventuellement, tu devras peut-être mettre à jour « 4.1.9 » ?)




en tous cas, mes félicitations pour ta rapidité à apporter tous les différents patchs
nécessaires ! 👍 (même si je n'ai actuellement pas besoin de ton calendrier ; peut-être plus tard,
sait-on jamais ?)


soan
 
re
a ben c'est un projet qui n'a pas de fin
je fait des mises a jours a fonctions des demandes (si elles sont pertinentes et apportent un plus)
et aussi en fonction des éventuelles coquille détectées
toujours dans l’esprit d'une compatibilité ( all excel version ) et prise en main facile même pour un débutant
😉
 
patricktoulon a mis à jour collection fausse boite de dialogue (Patricktoulon) episode 1 un vrai faux calendrier avec une nouvelle entrée de mise à jour:

correction bug sur les numero de semaine pour US et QUEBEC

bonjour a tous
juste une petite correction pour les numéros de semaine
l'index pour weekday n'etait pas dynamique
VB:
'mise ajour du clavier
Public Sub ReloadClavier()
    Dim X&, I&, A&, NB_JOURS&, Y&, WkD&, j&
    If Cbmonth.Value = "" Or Cbyear.Value = "" Then Exit Sub
    Select Case Calendar.region
    Case 0, 22: WkD = vbSunday: j = 1
    Case 1, 2, 12, 13, 33: WkD = vbMonday: j = 2
    End Select
    X = Weekday(DateSerial(Calendar.Cbyear, Calendar.Cbmonth.ListIndex + 1, 1), WkD)...

Lire le reste de cette entrée de mise à jour...
 
Dernière édition:
Bonjour Patrick,
Merci pour ce calendrier. Je me suis permis d'ajuster la liste des jours fériés dans le case 13 ( Suisse).
En effet certains de ces jours préalablement fixés dans le code ne sont pas fériés en Suisse et d'autres dépendent des cantons et également si le canton est majoritairement catholique ou non, c'est vraiment pas simple, et il y a même des spécificités locales au niveau d'une commune.
J'ai mis dans le code ce qui concerne mon canton et laissé en commentaires ceux qui ne me concerne pas.
Par contre on peut enlever sans autre le 14 juillet et le 11 novembre qui sont spécifiquement français.
A voir si tu veux l'inclure dans une prochaine version ou non.

Merci encore et meilleures salutations.
Cloburk
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour