Calendrier avec option de selection de dates_VBA

**Melodie7** · 05/04/2016, 19h20

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

Nom : Capture.PNG
Affichages : 369
Taille : 25,1 Ko

Nom : Capture.PNG
Affichages : 369
Taille : 25,1 Ko

Nom : Capture1.PNG
Affichages : 365
Taille : 33,9 Ko

Nom : Capture2.PNG
Affichages : 371
Taille : 30,7 Ko

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
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.

**EricDgn** · 05/04/2016, 23h19

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

**Melodie7** · 06/04/2016, 07h44

Merciiiiiiiiiiii!!!!!!!!

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 :

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

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

**EricDgn** · 06/04/2016, 09h25

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.

**Melodie7** · 06/04/2016, 15h30

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

**EricDgn** · 12/04/2016, 13h44

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.

**cerede2000** · 12/04/2016, 13h48

@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

**Melodie7** · 12/04/2016, 15h58

Bonjour,

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

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

Je l'ai aussi constaté! Ca plante.

Peux tu revoir ca stp EricDgn?

Merci d'avance.

**EricDgn** · 12/04/2016, 16h28

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.

**cerede2000** · 12/04/2016, 16h30

Merci à toi

Pour info

Code :

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

SendKeys "{ESC}"

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

Code :

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

Cancel = True

**EricDgn** · 12/04/2016, 17h44

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

**Melodie7** · 12/04/2016, 19h27

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.

**Melodie7** · 13/04/2016, 12h25

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

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

Macros et VBA Excel

Discussions similaires

Partager

Partager