Discussion :

[Arkham46]

Petite évolution :
- Choix d'une date en double-cliquant sur le calendrier
- Il est possible de mettre une liste de jours en gras

Cf le premier message de l'enfilade

[samtheh]

Merci pour ce super outil !!!

J'ai néanmoins un problème :

Lorsque la valeur est mise à jour dans le champ texte, l'evenement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Change()

n'est pas appelé, or j'en ai besoin pour réaliser des actions sur ma date.

Le problème c'est que si j'appel directement la méthode :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp_Change()

Il me donne une erreur comme quoi il ne peut changer la valeur d'un controle desactivé ou avec une méthode inxexistante. Dans ma méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp_Change()

je reccupere la valeur de mon champ date :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp.text

, si j'utilise

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp.value

je n'obtient pas la bonne valeur.

Je n'y comprend rien................;

Merci de votre aide !!

[Arkham46]

Merci pour ce super outil !!!

J'ai néanmoins un problème :

Lorsque la valeur est mise à jour dans le champ texte, l'evenement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Change()

n'est pas appelé, or j'en ai besoin pour réaliser des actions sur ma date.

Le problème c'est que si j'appel directement la méthode :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp_Change()

Il me donne une erreur comme quoi il ne peut changer la valeur d'un controle desactivé ou avec une méthode inxexistante. Dans ma méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp_Change()

je reccupere la valeur de mon champ date :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp.text

, si j'utilise

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp.value

je n'obtient pas la bonne valeur.

Je n'y comprend rien................;

Merci de votre aide !!

Bonjour samtheh,

Pour ton problème tu ne peux pas modifier un contrôle désactivé ça me semble normal.
Tu peux par VBA activer le contrôle avant de modifier la valeur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp.enabled = True

Puis le désactiver ensuite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

monChamp.enabled = Fasle

La différence entre Text et Value pour une zone de texte c'est que Text est la valeur affichée, Value est la valeur validée.
Il est normal qu'elle peut être différente.

[Serge57]

Outil très séduisant.

Merci Arkmam46

[Licha76]

Merci beaucoup pour le code, il fonctionne presque impecablement.

Cependant, comme cité plus haut et j ai essayé de réaliser la même mise en place dans des sous formulaire, le problème persiste.

Problème :

Quand je sélectionne le bouton date pour remplir le champs de mon sous formulaire en étant dans mon formulaire principal. La fenetre du choix des dates se positionne en tout en haut de mon formulaire principale. Cependant, il faut savoir que je suis sur la 3eme page donc je ne vois pas la fenetre du calendrier qui est en premiere...

Quelqu'un peut-il m'aider ?

Meri d'avance.

[Arkham46]

Bjr,

Quand je sélectionne le bouton date pour remplir le champs de mon sous formulaire en étant dans mon formulaire principal. La fenetre du choix des dates se positionne en tout en haut de mon formulaire principale. Cependant, il faut savoir que je suis sur la 3eme page donc je ne vois pas la fenetre du calendrier qui est en premiere...

Je ne saisis pas tout.
Qu'est ce qu'une "page" pour toi??
Le code est-il bien dans le module de code de sous-formulaire?
Quel est ce code??

[Licha76]

Désolé pour mon explication un peu sommaire mais je vais étayer .

Pour moi, une page était en rapport avec la mise en page que je donnais à mon formulaire (qui fait 3-4 pages) avec mes sous formulaire.


Le code que j ai mis sur mes sous formulaire est :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Option Compare Database
Option Explicit
 
Private Sub CmbDetailASE1_Click()
    Dim lDate As String
    lDate = DisplayCalendar(Me.TxtDetailASE1, "Choisir une date" & vbCrLf & "Valider avec la touche Ok", IIf(IsDate(Me.TxtDetailASE1), Me.TxtDetailASE1, Now), "Comic sans MS", 8, True, vbBlack, vbYellow, "arial", 10)
    If Not lDate = "" Then Me.TxtDetailASE1.Value = lDate
End Sub

Merci d'être aussi rapide pour les réponses

[Arkham46]

OK si je comprend bien, ton sous-formulaire est dans un onglet?
Je ne crois pas avoir testé cette configuration.

Essaye de remplacer dans le module MCalendar :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
       ' Remonte jusqu'au formulaire si contrôle dans onglets
        Do
            Err.Clear
            Set lParentForm = lParentForm.Parent
            If Err.Number <> 0 Then Err.Clear:  Exit Do
        Loop

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
       ' Remonte jusqu'au formulaire si contrôle dans onglets
	If TypeOf (lParentForm) Is TabControl Then
	        Do
	            Err.Clear
	            Set lParentForm = lParentForm.Parent
	            If Err.Number <> 0 Then Err.Clear:  Exit Do
	        Loop
	End If

J'ai pas access sous la main pour tester cette modif, je regarderai plus tard si nécessaire.

[Licha76]

Merci beaucoup pour ton aide ^^, ton ptit bijou se retrouve encore paufiné ^^.

Petite modif sur le code que tu m'as fourni avec les () en moins :p.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
         '' Remonte jusqu'au formulaire si contrôle dans onglets
    If TypeOf lParentForm Is TabControl Then
            Do
                Err.Clear
                Set lParentForm = lParentForm.Parent
                If Err.Number <> 0 Then Err.Clear:  Exit Do
            Loop
    End If

Il fonctionne très bien dans mes 7 sous formulaires .

Bonne continuation

[Arkham46]

Le bon code de correction était :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If TypeOf lParentForm Is Page Then ...

Les fichiers sont corrigés.

[thiefer]

Salut,

j'ai un problème sensiblement équivalent avec celui de Samthet mais je n'ai pas réussi à appliquer la solution d'Arkahm46...

Je mets deux champs txt_datedeb et txt_datefin avec chacun respectivement un cmb_datedeb et un cmbdatefin appelant le calendrier on click.
Je sélectionne par défaut en datedeb la date la plus ancienne de ma bdd et en datefin la date du jour.

Ce que je souhaite réaliser, c'est une modification du forecolor et du backcolor lorsque je sélectionne autre chose que les valeurs par défaut.
J'envisageais de faire cette modif su rlévénement on_change de chaque txt_date mais il n'y a aucun événement appliqué sur ces champs, ni modif, ni change ni rien...
De la même façon, je voulais également tester en retour de datefin qu'elle soit supérieure à datedeb.

Comment peut-on s'y prendre svp ?

Merci par avance de votre aide,

TF

[philben]

bonjour,

J'utilise depuis peu ce super calendrier , il fallait simplement que je repère en plus les jours fériés en France quelque soit l'année.

Je me suis donc permis d'ajouter cette option en essayant de préserver au maximum l'oeuvre d'Arkham46 c'est à dire en faisant un minimum de modification du code source (j'ai pas tout déchiffré non plus )...
Les jours fériés seront affichés en gras.

Voici ma méthode, si vous avez plus simple ou mieux, je suis preneur...

1) Dans un nouveau module standard ajouter le code suivant qui calcule les jours fériés (mobiles et fixes) et si le jour courant est un samedi ou dimanche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
Option Compare Database
Option Explicit
 
'Permet de conserver sans recalcul les jours fériés mobiles de l'année en cours
Private Type tJoursFete
   sLundiPaques As String
   sAscension As String
   sLundiPentecote As String
   iAnnee As Integer
End Type
 
Private tFetes As tJoursFete
 
'Détermine les jours fériés liés à pâques
'D'après un code de MC2 www.developpez.com
Private Sub SetJoursDeFete(ByVal iAn As Integer)
   Dim L(1 To 5) As Long, Lj As Long, Lm As Long
   Dim dPaques As Date
 
   L(1) = iAn Mod 19
   L(2) = iAn Mod 4
   L(3) = iAn Mod 7
   L(4) = (19 * L(1) + 24) Mod 30
   L(5) = (2 * L(2) + 4 * L(3) + 6 * L(4) + 5) Mod 7
   Lj = 22 + L(4) + L(5)
 
   If Lj > 31 Then
      Lj = Lj - 31
      Lm = 4
   Else
      Lm = 3
   End If
 
   dPaques = DateSerial(iAn, Lm, Lj)
   tFetes.sLundiPaques = Format(dPaques + 1, "ddmm")
   tFetes.sAscension = Format(dPaques + 39, "ddmm")
   tFetes.sLundiPentecote = Format(dPaques + 50, "ddmm")
   tFetes.iAnnee = iAn 'v1.01 : Evite recalcul pour chaque année
End Sub
 
' Retourne vrai si la date est un jour férié ou éventuellement samedi ou dimanche
' Ascension, lundi de Pâques, Lundi de Pentecôte, 1er janvier, 1er mai, 8 mai
' 14 juillet, 15 aout, 1er novembre, 11 novembre, 25 décembre
Public Function IsJourFerie(ByVal dDate As Date, Optional ByVal bWeekEnd As Boolean) As Boolean
   If bWeekEnd Then
      Select Case Weekday(dDate)
      Case vbSunday, vbSaturday
         IsJourFerie = True
      End Select
   End If
   If Not IsJourFerie Then
      If tFetes.iAnnee <> Year(dDate) Then SetJoursDeFete (Year(dDate))
      Select Case Format(dDate, "ddmm")
      Case tFetes.sAscension, tFetes.sLundiPaques, tFetes.sLundiPentecote, "0101", "0105", "0805", "1407", "1508", "0111", "1111", "2512"
         IsJourFerie = True
      End Select
   End If
End Function

2) Il faut déterminer dynamiquement si un jour est férié, pour ce faire on va modifier très légèrement la fonction <Private Sub FillMonthDayState(pDaystate As NMDAYSTATE, pMonthDayState() As Long)>, les modifications sont en rouge :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
'---------------------------------------------------------------------------------------
' Fonction interne : renvoie le paramètre pour message MCM_SETDAYSTATE
'---------------------------------------------------------------------------------------
Private Sub FillMonthDayState(pDaystate As NMDAYSTATE, pMonthDayState() As Long)
   Dim lCpt As Long, lsubcpt As Long, lcptarray As Long, lVarType As Long
   On Error GoTo gestion_erreurs
   For lCpt = 1 To pDaystate.cDayState
      pMonthDayState(lCpt) = 0
      For lsubcpt = 1 To 31
         For lcptarray = LBound(Cal_BoldDays) To UBound(Cal_BoldDays)
            lVarType = VarType(Cal_BoldDays(lcptarray))
            If lVarType = vbDate Then
               ' Test égalité de date
               If DateValue(Cal_BoldDays(lcptarray)) = DateSerial(pDaystate.stStart.wYear, pDaystate.stStart.wMonth - 1 + lCpt, lsubcpt) Then
                  pMonthDayState(lCpt) = pMonthDayState(lCpt) + 2 ^ (lsubcpt - 1)
                  Exit For
               End If
            ElseIf lVarType = vbBoolean Then
              If IsJourFerie(DateSerial(pDaystate.stStart.wYear, pDaystate.stStart.wMonth - 1 + lCpt, lsubcpt), Cal_BoldDays(lcptarray)) Then
                 pMonthDayState(lCpt) = pMonthDayState(lCpt) + 2 ^ (lsubcpt - 1)
                 Exit For
              End If
            Else
               ' Test égalité de jour de la semaine
               If Weekday(DateSerial(pDaystate.stStart.wYear, pDaystate.stStart.wMonth - 1 + lCpt, lsubcpt), vbMonday) = Cal_BoldDays(lcptarray) Then
                  pMonthDayState(lCpt) = pMonthDayState(lCpt) + 2 ^ (lsubcpt - 1)
                  Exit For
               End If
            End If
         Next
      Next
   Next
gestion_erreurs:
End Sub

3) Pour passer des jours particuliers au calendrier et les mettre en gras, Arkham46 utilise un Array (voir post n°1). On va l'utiliser pour passer dans ce tableau un booléen :

• exemple : Array(6,7,Booléen)
• si le booléen vaut <False>, seuls les jours fériés sont affichés en gras
• si le booléen vaut <True>, les Samedis et dimanches sont mis aussi en gras. Dans ce cas, le contenu du Array précédent peut être réduit à Array(True)

En espérant que ça vous soit utile, reste éventuellement à faire valider par l'auteur le principe retenu .

Amicalement,

Philippe

[faressam]

Juste une question que j'avais dèja emis,
j'affiche le calandrier, même avec les jours fériés,
mais je n'arrive pas à mettre le jours séléctionné dans une zone de texte
ou l'envoyer directement dans une table.

peut être que ce n'est pas la bonne Syntaxe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ZoneTexte.value = controlCalandrier.value

.

Merci pour votre aide. (et bravo pour le code et sa dernière amélioration).

[Arkham46]

il fallait simplement que je repère en plus les jours fériés en France quelque soit l'année.
[...] reste éventuellement à faire valider par l'auteur le principe retenu .

Amicalement,

Philippe

Bjr,

C'est plutôt bien comme ça
On peut même d'ailleurs tout mettre dans le même module si on ne sert pas des fonctions de jours fériés par ailleurs.


Pour ceux qui ont des difficultés avec l'utilisation de ce calendrier, essayez d'abord avec InputBox à la place de DisplayCalendar pour simplifier => et demandez de l'aide sur le forum si nécessaire.
Si ça marche avec une InputBox mais pas avec le Calendrier, revenez alors sur ce fil de discussion

Merci.

[Domi2]

Bonjour,

Je constate quelque chose de bizarre après avoir modifié mon code pour afficher les jours fériés et les week-end en gras.

Lors du premier affichage du calendrier (date aujourd'hui), l'affichage n'est pas correct (les jours en gras sont faux). Cela se corrige sitôt que je sélectionne un autre mois et que je reviens au mois en cours.

Par contre, en introduisant une date par défaut (par exemple le 1er janvier de cette année) à l'ouverture du formulaire, le calendrier est tout de suite correct...

Petit bug ou mauvais codage de ma part ? Ci-après, le code modifié :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
'---------------------------------------------------------------------------------------
' Fonction interne : renvoie le paramètre pour message MCM_SETDAYSTATE
'---------------------------------------------------------------------------------------
Private Sub FillMonthDayState(pDaystate As NMDAYSTATE, pMonthDayState() As Long)
 
    Dim lCpt As Long, lsubcpt As Long, lcptarray As Long, lVarType As Long
 
    For lCpt = 1 To pDaystate.cDayState
 
        pMonthDayState(lCpt) = 0
 
        For lsubcpt = 1 To 31
 
            For lcptarray = LBound(Cal_BoldDays) To UBound(Cal_BoldDays)
 
                lVarType = VarType(Cal_BoldDays(lcptarray))
 
                If lVarType = vbDate Then
 
                    'Test égalité de date
                    If DateValue(Cal_BoldDays(lcptarray)) = DateSerial(pDaystate.stStart.wYear, pDaystate.stStart.wMonth - 1 + lCpt, lsubcpt) Then
 
                        pMonthDayState(lCpt) = pMonthDayState(lCpt) + 2 ^ (lsubcpt - 1)
 
                        Exit For
 
                    End If
 
                ElseIf lVarType = vbBoolean Then
 
                    If EstFerie(DateSerial(pDaystate.stStart.wYear, pDaystate.stStart.wMonth - 1 + lCpt, lsubcpt), Cal_BoldDays(lcptarray)) Then
 
                        pMonthDayState(lCpt) = pMonthDayState(lCpt) + 2 ^ (lsubcpt - 1)
 
                        Exit For
 
                    End If
 
                Else
 
                    'Test égalité de jour de la semaine
                    If Weekday(DateSerial(pDaystate.stStart.wYear, pDaystate.stStart.wMonth - 1 + lCpt, lsubcpt), vbMonday) = Cal_BoldDays(lcptarray) Then
 
                        pMonthDayState(lCpt) = pMonthDayState(lCpt) + 2 ^ (lsubcpt - 1)
 
                        Exit For
 
                    End If
 
                End If
 
            Next
 
        Next
 
    Next
 
End Sub

Et le code du bouton, avec le paramètre à "True"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
strUneDate = DisplayCalendar(Me.txtDateDebut, "Choisir une date" & vbNewLine & "", _
                 IIf(IsDate(Me.txtDateDebut), Me.txtDateDebut, Now), _
                 "Arial", 8, True, vbBlack, , "Arial", 10, Array(True))

Quelqu'un a-t-il déjà constaté le même problème ?

Domi2

[Arkham46]

Quelqu'un a-t-il déjà constaté le même problème ?

j'ai testé avec la modif de philben et pas vu de soucis

[Domi2]

Bonjour,

Alors j'ai multiplié les tests, je suis sous Access XP.

Le problème se produit uniquement avec le mois de décembre, que ce soit avec le code initial ou celui modifié de Philben, et aussi bien avec Windows Vista que Windows XP...

Bon, y'a pas de quoi fouetter un chat...

Domi2

[philben]

bonjour Domi2,

j'ai testé sous Access 2003 et 2007 (win xp) avec le mois de décembre et ça fonctionne.

Un debug pas à pas sous Access 2002 est nécessaire...

Philippe

[User]

Tout comme Philben,

Chez moi ça marche impeccable sous Access 2003,

Bravo

[metallicavid]

J'ai réussi sous Access 2000, en copiant les codes dans mon formulaire et en modifiant les noms qui étaient déja présent dans mon formulaire indépendant.

Merci pour tout cela