Calendrier mensuel avec checkbox

Version imprimable

20/08/2009, 09h00
altra

2 pièce(s) jointe(s)

Calendrier mensuel avec checkbox

Bonjour le forum,

Je voudrais faire un calendrier mensuel du type de ceux qu'on trouve sur les agences de voyages ou SNCF ci joint le calendrier SNCF.
http://www.developpez.net/forums/att...3&d=1250750222
Pour l'instant vous pouvez voir ce que j'ai fait en pièce jointe moncalendrier.
http://www.developpez.net/forums/att...4&d=1250750224
J'ai crée un tableau de 5 lignes et 7 colonnes, avec une colonne pour chaque jour de la semaine. J'ai mis une checkbox sous chaque cellule.
Mon problème est pour afficher la date comme je le veux.
Si le premier jour du mois est un jeudi par exemple. Sous la case jeudi il doit afficher 1 et sous la case du jour de la veille 28,29,30,31 suivant le mois et aller jusque au dernier jour de la semaine du dernier jour du mois. En plus clair si le dernier jour est un mardi 31, la macro continue de compter jusqu'au dimanche 5 dans ce cas la.

Je n'ai aucune idée de départ. Je sais afficher les jours du mois mais ce qui me pose réellement probleme se sont les quelques jours avant et aprés le mois.

Merci pour vos propositions

Bonne journée
20/08/2009, 09h50
Many31

Bonjour,

Je voudrais pas paraitre grossier... Mais il y a un objet Calendrier qui peut être placé dans les USF et qui correspond exactement à l'exemple que tu nous montres :/

Référence à activer :
Microsoft Calendar Control 11.0

Il y a juste un MAIS c'est que cette référence ne se retrouve pas sur toutes les versions d'Excel (à installer si nécessaire donc)
20/08/2009, 10h07
altra

Malheureusement je ne trouve pas cette référence, et je n'ai pas l'autorisation pour installer de nouvelles références.

J'ai quelquechose comme SAP calendar control mais il affiche une fenetre noire, je ne sais pas comment le faire marcher. Peut etre que cela pourrait marcher?
20/08/2009, 10h49
altra

Tout compte fait je viens de trouver la dite référence sous le nom Calendar, moi je chercher avec Microsoft en premier mot.

Ca ressemble tres fortement à ce que je voudrais faire, mais est il possible de sélectionner plusieurs jours. Quel le code qui controle la selection multiple.

Merci encore
20/08/2009, 10h53
Many31
Je ne connais pas cette référence

Pour partir sur l'exemple que tu donnes, utilise la fonction Weekday pour connaitre le nom du premier jour du mois (Weekday("01/02/2009", vbMonday) par exemple te renvois 7 qui correspond à Dimanche)

Une fois cette valeur connue, tu peux utiliser la fonction DateSerial pour trouver la date du jour avant celle du premier jour de ton mois et le dernier:

DateSerial(2009, 3, 1 - 1) te renverra la date du jour avant le 01/03/2009 c'est à dire le 28 Février 2009

Donc en gros pour le mois de Février tu auras besoin de 3 fonctions:
Code:

1 2 3 Weekday("01/02/2009", vbMonday) 'Jour du 1° Février 2009 Day(DateSerial(2009, 3, 1 - 1)) 'Dernier jour du mois de Février Day(DateSerial(2009, 2, 1 - 1)) 'Dernier jour du mois de janvier
20/08/2009, 11h09
altra

Il semblerait que la sélection multiple ne soit pas possible avec le Calendar Control 11.0.
Néanmoins elle est possible avec MonthView Control 6.0. Par contre comment faire pour récupérer l'ensemble des dates sélectionnées. Avec l'article de Silkyroad j'arrive bien à selectionner la date cliquée (cad la premiere de la selection) mais pour les autres je ne sais.

En parallele je vais aussi regarder ta proposition Many31, ça peut être un bon début.

Merci

Bonjour le forum,

J'ai un peu avancé. Il me reste a afficher correctement les quelques jours qui précedent le mois en cours.
Voici mon code :

Code:

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
'****************************************************************************************
'Function nbjmois
'Cette fonction détermine le nombre de jours dans un mois
'***************************************************************************************
Public Function nbjmois(ByVal ma As Date) As Integer
Dim ms As Date
 
If Month(ma) = 12 Then
    nbjmois = 31
Else
    ms = CDate("01/" & Month(ma) + 1 & "/" & Year(ma)) 'la date du premier jour du mois suivant
    nbjmois = Day(DateAdd("D", -1, ms))    'retrancher 1 jour et récuperer le jour
End If
 
End Function
 
'************************************************************************************
 
Sub Calendrier()
 
With Union(Rows(12), Rows(16), Rows(20), Rows(24), Rows(28))
    .NumberFormat = "[$-40C]dd-mmm;@"
End With
 
Mois = Month(Date)
Année = Year(Date)
PreJour = Weekday("01/" & Mois & "/" & Year(Date), vbMonday)
Finmois = Day(DateSerial(Année, Mois, 1 - 1))
DebMois = Day(DateSerial(Année, Mois + 32, 1 - 1))
NumJour = Mois & "/01/" & Année
 
Select Case PreJour
    Case Is = 1
        Range("D12") = NumJour
        ColDeb = 4
    Case Is = 2
        Range("E12") = NumJour
        ColDeb = 5
    Case Is = 3
        Range("F12") = NumJour
        ColDeb = 6
    Case Is = 4
        Range("G12") = NumJour
        ColDeb = 7
    Case Is = 5
        Range("H12") = NumJour
        ColDeb = 8
    Case Is = 6
        Range("I12") = NumJour
        ColDeb = 9
    Case Is = 7
        Range("J12") = NumJour
        ColDeb = 10
End Select
 
dtedate = "01/" & Mois & "/" & Année 'variable qui contient la date actuelle et commence au premier jour du mois
 
dtefin = Finmois & "/" & Mois - 1 & "/" & Année
 
LigFin = 32
LigDeb = 12
ColFin = 10
 
    For col = ColDeb To ColFin
       Cells(LigDeb, col).Value = DateAdd("D", i, dtedate)
        i = i + 1
    Next
 
Caldeb = 4
 
For col = Caldeb To ColDeb - 1
    Cells(LigDeb, col).Value = DateAdd("D", i - 1, dtefin)
    i = i - 1
Next
 
 
    For lig = LigDeb + 4 To LigFin
        For col = Caldeb To ColFin
            Cells(lig, col).Value = DateAdd("D", i, dtedate)
            i = i + 1
        Next
        lig = lig + 3
    Next
 
End Sub

Mon principal probleme est l'affichage des quelques jours qui precedent le début du mois en cours sur la premiere ligne du calendrier. En fait je n'arrive pas à les afficher dans le bon sens. Pour l'instant j'ai 31 juil ; 30 juil ; 29 juil ; 28 juil ; 01 aout ; 02 aout. Et j'aimerais avoir 28,29,30,31,01,02.

Merci pour votre aide

Bonne journée

J'ai trouvé tout seul. J'ai découvert l'attribut step dans la boucle for qui fait ce que je voulais.
Donc voici le code pour l'affichage des dates.

Code:

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
'****************************************************************************************
'Function nbjmois
'Cette fonction détermine le nombre de jours dans un mois
'***************************************************************************************
Public Function nbjmois(ByVal ma As Date) As Integer
Dim ms As Date
 
If Month(ma) = 12 Then
    nbjmois = 31
Else
    ms = CDate("01/" & Month(ma) + 1 & "/" & Year(ma)) 'la date du premier jour du mois suivant
    nbjmois = Day(DateAdd("D", -1, ms))    'retrancher 1 jour et récuperer le jour
End If
 
End Function
 
'************************************************************************************
 
Sub Calendrier()
 
'met la colonne A au format 01-août-09
With Union(Rows(12), Rows(16), Rows(20), Rows(24), Rows(28), Rows(32))
    .NumberFormat = "[$-40C]dd-mmm;@"
End With
 
Mois = Month(Date)
Année = Year(Date)
PreJour = Weekday("01/" & Mois & "/" & Year(Date), vbMonday)
Finmois = Day(DateSerial(Année, Mois, 1 - 1))
DebMois = Day(DateSerial(Année, Mois + 32, 1 - 1))
NumJour = Mois & "/01/" & Année
 
Select Case PreJour
    Case Is = 1
        Range("D12") = NumJour
        ColDeb = 4
    Case Is = 2
        Range("E12") = NumJour
        ColDeb = 5
    Case Is = 3
        Range("F12") = NumJour
        ColDeb = 6
    Case Is = 4
        Range("G12") = NumJour
        ColDeb = 7
    Case Is = 5
        Range("H12") = NumJour
        ColDeb = 8
    Case Is = 6
        Range("I12") = NumJour
        ColDeb = 9
    Case Is = 7
        Range("J12") = NumJour
        ColDeb = 10
End Select
 
dtedate = "01/" & Mois & "/" & Année 'variable qui contient la date actuelle et commence au premier jour du mois
dtefin = Finmois & "/" & Mois - 1 & "/" & Année
'cette boucle permet d'afficher la date dans la 1ere colonne et d'incrémenter le jour du mois jusqu'à la fin du mois
LigFin = 32
LigDeb = 12
ColFin = 10
Caldeb = 4
 
    For col = ColDeb - 1 To Caldeb Step -1
        Cells(LigDeb, col).Value = DateAdd("D", j, dtefin)
    j = j - 1
    Next
 
    For col = ColDeb To ColFin
       Cells(LigDeb, col).Value = DateAdd("D", i, dtedate)
        i = i + 1
    Next
 
 
 
    For lig = LigDeb + 4 To LigFin
        For col = Caldeb To ColFin
            Cells(lig, col).Value = DateAdd("D", i, dtedate)
            i = i + 1
        Next
        lig = lig + 3
    Next
 
End Sub

Peut etre qu'il y a des choses à simplifier, alors nn'hésitez pas à m'en faire part.

Merci et bonne journée

J'ai fait une petite modif, elle est en rouge pour que tu puisse voir ou c'est:
ça fonctionne pour la première ligne, mais il faut que tu revoie l'initialisation de la deuxième ligne (je te met la boucle en vert ) car elle ne part pas de la bonne date, à moins que ce ne soit voulu

Code:

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
60
61
62
63
64
65
Sub Calendrier()
 
With Union(Rows(12), Rows(16), Rows(20), Rows(24), Rows(28))
    .NumberFormat = "[$-40C]dd-mmm;@"
End With
 
Mois = Month(Date)
Année = Year(Date)
PreJour = Weekday("01/" & Mois & "/" & Year(Date), vbMonday)
Finmois = Day(DateSerial(Année, Mois, 1 - 1))
DebMois = Day(DateSerial(Année, Mois + 32, 1 - 1))
NumJour = Mois & "/01/" & Année
 
Select Case PreJour
    Case Is = 1
        Range("D12") = NumJour
        ColDeb = 4
    Case Is = 2
        Range("E12") = NumJour
        ColDeb = 5
    Case Is = 3
        Range("F12") = NumJour
        ColDeb = 6
    Case Is = 4
        Range("G12") = NumJour
        ColDeb = 7
    Case Is = 5
        Range("H12") = NumJour
        ColDeb = 8
    Case Is = 6
        Range("I12") = NumJour
        ColDeb = 9
    Case Is = 7
        Range("J12") = NumJour
        ColDeb = 10
End Select
 
dtedate = "01/" & Mois & "/" & Année 'variable qui contient la date actuelle et commence au premier jour du mois
 
dtefin = Finmois & "/" & Mois - 1 & "/" & Année
 
LigFin = 32
LigDeb = 12
ColFin = 10
 
    For col = ColDeb To ColFin
       Cells(LigDeb, col).Value = DateAdd("D", i, dtedate)
        i = i + 1
    Next
    
Caldeb = 4
 
For col = ColDeb To Caldeb Step -1
    Cells(LigDeb, col).Value = DateAdd("D", i - 1, dtefin)
    i = i - 1
Next 
 
    For lig = LigDeb + 4 To LigFin
        For col = Caldeb To ColFin
            Cells(lig, col).Value = DateAdd("D", i, dtedate)
            i = i + 1
        Next
        lig = lig + 3
    Next 
End Sub

Edit: laisse tomber mon code , le tiens fonctionne et tu as trouvé le step-1

Plus simple???

Code:

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
Option Explicit
Sub Calendr()
Dim auj As Integer
Dim dte As Date, dted As Date, dtePS As Date, dteSV As Date
Dim i As Integer
Dim LigD As Integer, Kold As Integer
Dim LigSV As Integer, KolSV As Integer, jrSV As Integer
 
dte = Date  'date d'aujourd'hui ou autre date
 
dted = CDate("01/" & Month(dte) & "/" & Year(dte))   'le premier jour du mois
 
Kold = 3 + Weekday(dted, 2)
LigD = 12
 
 
Cells(LigD, Kold).Value = Format(dted, "dd mmm")
 
    dtePS = dted                                          'Derniers jours du mois précédents
    For i = Kold - 1 To 4 Step -1
        dtePS = DateAdd("d", -1, dtePS)
        Cells(LigD, i).Value = Format(dtePS, "dd mmm")
    Next i
 
    dteSV = dted         'Jours suivants
    KolSV = Kold
    LigSV = 12
    Do
        dteSV = DateAdd("d", 1, dteSV)
        jrSV = Day(dteSV)
        KolSV = KolSV + 1
        If KolSV > 10 Then
            KolSV = 4
            LigSV = LigSV + 4
        End If
 
        Cells(LigSV, KolSV).Value = Format(dteSV, "dd mmm")
    Loop Until KolSV = 10 And LigSV = 32
End Sub

21/08/2009, 13h56
altra

Merci Diurne54 et Mercatog.

Comme ça je saurais utiliser les boucle do loop.

Bonne journée
21/08/2009, 14h03
mercatog

Ci joint fichier test pour toutes fins utiles

Edit, Nouveau Fichier
21/08/2009, 14h13
altra

Merci pour le Datediff que je ne connaissais pas.

J'avais fait quelquechose de plus compliqué (comme d'habitude) pour la coloration du jour d'aujourd'hui.