[XL-2010] Calendrier avec option de selection de dates

5 pièce(s) jointe(s)

Calendrier avec option de selection de dates_VBA

Bonjour à tous!
Je suis débutante en VBA.

j'ai un gros problème depuis plusieurs jours. j'ai essayé plusieurs méthodes mais aucune n'est la solution.

J'aimerais créer un calendrier dans Excel qui permet d'afficher les dates souhaitées.
Dans la colonne A j'ai la liste des jours du calendrier et en B l'état des cases à cocher (VRAI si la case est coché et FAUX si elle n'est pas cochée). si je coches sur une case la date qui est à côté doit être remplacée par la date suivante. Autrement dit je coche une case pour que cette case ne s'affiche pas dans le calendrier.

Cela doit être possible lorsqu'on coche plusieurs cases.
Mon code ne fonctionne que pour une .
J'ai besoin d'aide au plus vite svp: d'autres variantes de code ou une amélioration de mon code

Merci d'avance pour vos réponses

Pour ceux qui n'ose pas ouvrir le fichier

Pièce jointe 206042

Pièce jointe 206047

Pièce jointe 206048

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
Sub Datum()
 
Dim z As Integer
Dim s As Integer
 
z = 5
s = 21
 
Worksheets("Gesamtübersicht").Activate
If Cells(z, 2).Value = True And Cells(z + 1, 2).Value = False And Cells(z + 2, 2).Value = FalseAnd And Cells(z + 3, 2).Value = False And Cells(z + 4, 2).Value = False And Cells(z + 5, 2).Value = False And Cells(z + 6, 2).Value = False And Cells(z + 7, 2).Value = False And Cells(z + 8, 2).Value = False And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 1
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = False And Cells(z + 3, 2).Value = False And Cells(z + 4, 2).Value = False And Cells(z + 5, 2).Value = False And Cells(z + 6, 2).Value = False And Cells(z + 7, 2).Value = False And Cells(z + 8, 2).Value = False And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 2
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = False And Cells(z + 4, 2).Value = False And Cells(z + 5, 2).Value = False And Cells(z + 6, 2).Value = False And Cells(z + 7, 2).Value = False And Cells(z + 8, 2).Value = False And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 3
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = True And Cells(z + 4, 2).Value = False And Cells(z + 5, 2).Value = False And Cells(z + 6, 2).Value = False And Cells(z + 7, 2).Value = False And Cells(z + 8, 2).Value = False And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 4
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = True And Cells(z + 4, 2).Value = True And Cells(z + 5, 2).Value = False And Cells(z + 6, 2).Value = False And Cells(z + 7, 2).Value = False And Cells(z + 8, 2).Value = False And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 5
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = True And Cells(z + 4, 2).Value = True And Cells(z + 5, 2).Value = True And Cells(z + 6, 2).Value = False And Cells(z + 7, 2).Value = False And Cells(z + 8, 2).Value = False And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 6
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = True And Cells(z + 4, 2).Value = True And Cells(z + 5, 2).Value = True And Cells(z + 6, 2).Value = True And Cells(z + 7, 2).Value = False And Cells(z + 8, 2).Value = False And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 7
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = True And Cells(z + 4, 2).Value = True And Cells(z + 5, 2).Value = True And Cells(z + 6, 2).Value = True And Cells(z + 7, 2).Value = True And Cells(z + 8, 2).Value = False And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 8
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = True And Cells(z + 4, 2).Value = True And Cells(z + 5, 2).Value = True And Cells(z + 6, 2).Value = True And Cells(z + 7, 2).Value = True And Cells(z + 8, 2).Value = True And Cells(z + 9, 2).Value = False And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 9
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = True And Cells(z + 4, 2).Value = True And Cells(z + 5, 2).Value = True And Cells(z + 6, 2).Value = True And Cells(z + 7, 2).Value = True And Cells(z + 8, 2).Value = True And Cells(z + 9, 2).Value = True And Cells(z + 10, 2).Value = False Then
Cells(3, s) = (Cells(z, 1).Value) + 10
ElseIf Cells(z, 2).Value = True And Cells(z + 1, 2).Value = True And Cells(z + 2, 2).Value = True And Cells(z + 3, 2).Value = True And Cells(z + 4, 2).Value = True And Cells(z + 5, 2).Value = True And Cells(z + 6, 2).Value = True And Cells(z + 7, 2).Value = True And Cells(z + 8, 2).Value = True And Cells(z + 9, 2).Value = True And Cells(z + 10, 2).Value = True Then
Cells(3, s) = (Cells(z, 1).Value) + 11
 
 
End Sub

Ci- Joint le fichier Excel. Dans la feuille de programmation, il y a d'autres essais de code qui ne marchent pas.

1 pièce(s) jointe(s)

Une variante

Plutôt que de recalculer les colonnes, une solution qui masque simplement les colonnes correspondant aux dates cochées.
Bonne continuation.

Très bonne variante

Merciiiiiiiiiiii!!!!!!!! :D
Cela me va aussi comme ca. J'essaierai de comprendre le code. Ou si vous avez du temps, pouvez vous me l'expliquer svp?
Merci encore pour tout ericDgn.
Code:

1 2 3 4 5 6 7 8 Sub Datum() Dim dDate As Date, kR As Long dDate = DateSerial([A3], [A2], [A1]) - 1 Debug.Print dDate For kR = 1 To 50 Cells(kR + 4, 1) = dDate + kR Next kR End Sub

La macro Datum() est appelée à chaque modification apportée à la date par les 3 contrôles placés en haut à gauche de la feuille.
[A1], [A2],[A3] sont les contenus des cellules A1, A2, A3 ... ce qui permet de calculer la date de départ (avec -1 car 1 sera rajouté au démarrage de la boucle For ... Next)
La boucle For ... Next inscrit la date dans la colonne 1 à partir de la 5e ligne, en commençant par la date de départ.
Bonne continuation.

Hello,

Un Grand merci pour votre disponibilité et votre Aide.
J'avais un autre problème mais j'ai trouver comment faire.

Bonne fin de journée

Toutefois j'aimerais connaître la solution sans le mascage de cellule.

Donc j'attends encore d'autres reponses

1 pièce(s) jointe(s)

Variante 2

C'est du simple recopiage: les dates de la colonne A non cochées en colonne B sont recopiées l'une après l'autre sur la ligne 3.

@EricDgn : Problème avec ton classeur !
Je l'ouvre => Ok
Je supprime un X => curseur qui changer rapidement entre croix et rond et Excel qui plante :mouarf:

Bonjour, :D
Merci d'avoir cherché une autre variante EricDgn.
Mais il y a un problème Avec le fichier Excel.

Citation:

Envoyé par cerede2000

@EricDgn : Problème avec ton classeur !
Je l'ouvre => Ok
Je supprime un X => curseur qui changer rapidement entre croix et rond et Excel qui plante :mouarf:

Je l'ai aussi constaté! Ca plante. :?
Peux tu revoir ca stp EricDgn?

Merci d'avance.

1 pièce(s) jointe(s)

Variante 2bis

Corrigé: un code accepté sur une machine en Excel 2007 ne l'est pas sur une autre en Excel 2010.
Cocher/décocher par double-clic en colonne B
Bonne continuation.

Merci à toi :)
Pour info

Code:

SendKeys "{ESC}"

ne fonctionne pas et de toute manière il faut utiliser

Code:

Cancel = True

;)

Effectivement, Cancel est nettement préférable à SendKeys.
Bonne soirée.

Fichier impossible à ouvrir

Bonsoir,

J’étais au boulot tout à l'heure (sur Excel 2007) et j'arrivais au moins à ouvrir le fichier même si ça plantais.

Et là j'arrive à la maison, j'essaie d'ouvrir le nouveau fichier que tu as ajouté sur mon PC (Excel 2010) mais je n'arrive même pas à l'ouvrir. :? Je me demande ce qui ne va pas.

Je vais essayé de l'ouvrir demain au boulot. J'espère que ça va marcher.

RESOLU!!!!

Bonjour,
J'ai essayé et ça marche.
Merci EricDgn