[RÉSOLU + Améliorations en continu] Rendre le calendrier mensuel de David XLD pérenne

[Gen Rose]

Bonjour

J'ai déjà notifié David XLD sur le sujet mais dans l'idée que plusieurs têtes valent mieux qu'une, j'ai pensé à vous tous.

En p.j. le calendrier en question et quelques info sur celui-ci:

Licence:Libre de droits, mentions de l'auteur appréciée
Envoyé le: 01 Jan 2013
Envoyé par: David AUBERT (XLDadmin)
Date: 31 Dec 2012
Auteur: Calendrier2013.net
Taille: 125.50 Kb
Type: xls
Site Web:Click to visit site

J'ai pensé que nous pourrions passer en VBA pour adapter ce calendrier en p.j. et le rendre pérenne.
Avec une feuille 'Choix Annee'; nous pourrions choisir l'année qui ajuste les mois et jours et aussi avoir un bouton pour la synthèse de l'année en cours.

La synthèse pourrait se faire sur une seule feuille à la fin du classeur de façon simple, sans MEF, juste le nécessaire.
Elle pourrait la nommer Synthannéeencours et simplement tout reporter tel l'exemple de la Feuil ‘Synth2012’.

Ce ne sont que des propositions et des idées en l'air.

Mon idée est de le faire partager par un des modérateurs du site dans la zone Téléchargement pour tous car j'ai beaucoup aimé le calendrier de David XLD pour sa simplicité et je crois que cela vaudrait la peine de rendre, si on veut, éternel

Moment quétaine mis à part, qu'en pensez-vous?

 

[Gen Rose]

Re : Rendre le calendrier mensuel de David XLD pérenne

Hum, avec un mois de février à 30 jours et de mars à 30 jours également, l'année 2014 s'annonce singulière

HAhahaha!!! Je l'ai bien ri! En effet, toute une année en perspective! Merci de m'avoir pointé cette erreur monumentale!

JNP, Ta formule est super; j'ai vraiment envie de l'adopter mais je dois trouver un moyen de conserver ma première feuille pour le choix de l'année; ensuite, les mois en ligne1 des feuilles pourraient suivre ce choix...je cogite là-dessus et merci beaucoup pour ton aide, j'apprécie beaucoup.

Boigontier, c'est super Je vais tenter de trouver un moyen d'ajouter à la macro la création d'une feuille avec cette synthèse car je tiens à l'affecter au bouton 'Synthèse de l'année en cours' de la page 'Choix Annee'.
Cette solution est vraiment géniale et fonctionnelle; je t'en remercie sincèrement. Il est bien possible que je la conserve ainsi si je fini par perdre patience

J'espère vous revenir avec un document final parfait que je pourrai poster en retour sur le fil de David XLD

Cdt,
Le Forum

 

[JNP]

Re : Rendre le calendrier mensuel de David XLD pérenne

Re

j'ai vraiment envie de l'adopter mais je dois trouver un moyen de conserver ma première feuille pour le choix de l'année; ensuite, les mois en ligne1 des feuilles pourraient suivre ce choix...je cogite là-dessus et merci beaucoup pour ton aide, j'apprécie beaucoup.

Et on dira que les femmes ne sont pas têtues...
Voilà

 

[BOISGONTIER]

Re : Rendre le calendrier mensuel de David XLD pérenne

La feuille synthèse est générée à partir du bouton de la page d'accueil.

Sub synthese3()
  On Error Resume Next
  Application.DisplayAlerts = False
  Sheets("synthèse" & [choixAnnee]).Delete
  On Error GoTo 0
  Sheets("modèle").Copy After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "synthèse" & [choixAnnee]
  Set f = Sheets(ActiveSheet.Name)
  [a2:b367].ClearContents
  ligEvent = 2
  For m = 1 To 12
    mois = Format(DateSerial(2014, m, 1), "mmmm")
    For ligne = 4 To 14 Step 2
      For col = 1 To 7
        dt = Sheets(mois).Cells(ligne - 1, col)
        'dt = DateSerial([choixannee], m, Sheets(mois).Cells(ligne - 1, col)) ' calend Geneviève
        texte = Sheets(mois).Cells(ligne, col)
        If texte <> "" And dt <> "" Then
           f.Cells(ligEvent, 1) = dt
           f.Cells(ligEvent, 2) = texte
           ligEvent = ligEvent + 1
        End If
      Next col
    Next ligne
  Next m
  Columns("B:B").EntireColumn.AutoFit
End Sub
End Sub

Cf PJ

Cf http://boisgontierjacques.free.fr/fichiers/Dates/CalendrierXLD.xls
Cf http://boisgontierjacques.free.fr/fichiers/Dates/CalendrierXLD2.xls

JB

 

[Gen Rose]

Re : Rendre le calendrier mensuel de David XLD pérenne

JNP
: Et on dira que les femmes ne sont pas têtues

Hahaha! Moi, je préfère dire que je sais ce que je veux

Mais bon, les gars en général ont leur propres termes et on vous les laisse, car ça vous fait bien plaisir et que nous sommes patientes et compréhensives

J'ai adapté exactement de la même manière que toi (la solution était plus facile que je croyais) et merci beaucoup pour ton aide et tes milliers de bonhommes sourires C'est trop joyeux.

Boigontier, dieu que j'aimerais coder ainsi. Ça fonctionne très bien mais comme l'expression le dit; Il n'y a que les fous qui ne changent pas d'idée' (Non JNP, ce n'est pas que je ne sais pas ce que je veux, c'est plutôt que je surf sur la vague!) alors j'ai décidé de conserver la première synthèse, avec bouton sur la page directement( voir post #14 de ce fil)

Bémol; erreur d'excécution. Je m'y attendais; J'ai fusionné vos 2 solutions et elle ont besoin de s'adapter une à l'autre.

Boigontier, peux-tu jeter un oeil? Je sais que cela a rapport aux lignes 1 des pages; j'ai changé l'entête selon le modèle de JNP.

Merci beaucoup,

 

[BOISGONTIER]

Re : Rendre le calendrier mensuel de David XLD pérenne

Sub synthese3()
  Set f = Sheets(ActiveSheet.Name)
  [a2:b367].ClearContents
  ligEvent = 2
  For m = 1 To 12
    mois = Format(DateSerial(2014, m, 1), "mmmm")
    For ligne = 4 To 14 Step 2
      For col = 1 To 7
        jour = Sheets(mois).Cells(ligne - 1, col).Value
        If jour <> 0 Then
          dt = DateSerial(Year([choixannee]), m, jour)
          texte = Sheets(mois).Cells(ligne, col)
          If texte <> "" Then
            f.Cells(ligEvent, 1) = dt
            f.Cells(ligEvent, 2) = texte
            ligEvent = ligEvent + 1
          End If
         End If
       Next col
    Next ligne
  Next m
End Sub

raz des commentaires

Sub razCmt()
  If MsgBox("Etes vous sûr de supprimer tous les commentaires?", vbYesNo) = vbYes Then
    For m = 1 To 12
      mois = Format(DateSerial(2014, m, 1), "mmmm")
      For ligne = 4 To 14 Step 2
         Sheets(mois).Cells(ligne, 1).Resize(, 7) = Empty
      Next ligne
     Next m
   End If
End Sub

JB

 

[Si...]

Re : Rendre le calendrier mensuel de David XLD pérenne

salut

le sujet m"ayant intéressé, j'avais cherché un peu.
Je n'ai pas saisi l'intérêt du changement de date (ou je n'ai pas bien lu ).
Faut-il réinitialiser l'agenda ou simplement corriger l'année ?
Dans ce dernier cas, il peut y avoir des données non datées et qu'en faire ?
Voir l'exemple avec une protection quant aux changements intempestifs des cellules de date (pas eu le temps de tester beaucoup).

 

[Gen Rose]

Re : Rendre le calendrier mensuel de David XLD pérenne

Re le Fil,

@ Boigontier; ça fonctionne comme un charme. Un seul mot: parfait

Je post le document complètement fonctionnel pour clore le sujet, encore merci pour ton aide.

Bien anticipé pour l'effacement; j'avais commencé une macro fonctionelle mais j'étais bloquée à l'étape d'appliquer l'effacement au feuilles Janvier: Décembre...en regardant ta macro Raz, je vais tenter de terminer la mienne pour voir si j'y arrive.

@Si...

Vraiment, super les macro: Ça fonctionne parfaitement et c'est rapide. Tel qui l'est, il clos aussi le sujet.

J'aimerais tout de même y ajouter le raz des commentaires à Boigontier mais je n'y arrive pas encore :variable non définie.

En effet, je comptais sur la vigilance des utilisateurs pour ne pas écrire dans les cases sans dates mais ta solution évite justement ce problème! C'est tout simplement génial J'aurais pu passer par la protection des feuilles mais c'est tellement plus simple avec ta macro.

Encore merci à vous tous,
Le Forum,

 

[Gen Rose]

Re : [RÉSOLU MERVEILLEUSEMENT] Rendre le calendrier mensuel de David XLD pérenne

FYI; j'ai posté les 2 doc sur le fil dédié au document original de DavidXLD.

@ +

 

[Si...]

Re : [RÉSOLU MERVEILLEUSEMENT] Rendre le calendrier mensuel de David XLD pérenne

salut

J'aimerais tout de même y ajouter le raz des commentaires

avec un bouton dont le code serait :

Sub Rectangle2_Cliquer()
  Dim F As Worksheet
  For Each F In Sheets
    If F.Name <> "Choix Annee" And F.Name <> "Synthèse" Then _
      F.Range("A4:G4,A6:G6,A8:G8,A10:G10,A12:G12") = ""
  Next
End Sub

Il y avait une ligne à compléter dans la macro Activate de la feuille Synthèse :
F.Range("A4:G4,A6:G6,A8:G8,A10:G10,A12:G12") = ""

A noter que le changement de date ne permet pas de réinitialiser la feuille Synthèse. Elle peut l'être si, immédiatement après le changement, on le demande avec le premier bouton.

 

[Gen Rose]

Re : [RÉSOLU MERVEILLEUSEMENT] Rendre le calendrier mensuel de David XLD pérenne

Bonjour Si...

Peux-tu jeter un coup d'oeil au f-j.?

Mon but était de faire en sorte que les zones sans dates soient colorées alors pour activer la MFC, J'ai mis des 0 à la place des "".

Cela a déstabilisé les macro...je m'en excuse mais c'est plus fort que moi, je veux vraiment que ces zones soient colorées tel un agenda.

J'ai ajouté la macro rectangle 2 mais elle ne fonctionne que sur la feuille Janvier, à cause bien entendu que j'ai tout bousillé avec ma modification des formules en ligne 4 et 12. Je m'excuse...

 

[Si...]

Re : [RÉSOLU MERVEILLEUSEMENT] Rendre le calendrier mensuel de David XLD pérenne

re

il suffisait de remplacer "" par 0 dans la "bonne" macro .
Je donne quelques explications dans le fichier joint en profitant de réparer quelques lignes et reste à disposition pour d'éventuelles corrections d'erreur.

 

[Herdet]

Re : [RÉSOLU MERVEILLEUSEMENT] Rendre le calendrier mensuel de David XLD pérenne

Bonjour,
Le titre RESOLU MERVEILLEUSEMENT est... merveilleusement trompeur car tant qu'il y a des questions et des bugs, rien n'est résolu.

A mon avis, pour rendre le calendrier vraiment pérenne, il serait souhaitable :

1) d'éviter ce que j'appelle la bataille navale et définir des noms de plages de cellules.
Sinon il y a des plantages lorsque l'on déplace les tableaux dans les feuilles
.Range("A4:G4,A6:G6,A8:G8,A10:G10")
Intersect(R, Range("A3:G3,A5:G5,A7:G7,A11:G11"))
Cells(65000, 1).End(xlUp)(2) = CDate(R(0, 1) & "/" & Month(F.[A1].Value) & "/" & Feuil14.[G8])

2) de ne pas mettre des noms de feuilles "en dur" dans le VBA mais les renommer puis corriger le code tel que ci-dessous

If F.Name <> Sh_Synthese.Name And F.Name <> Sh_annee.Name Then
au lieu de If F.Name <> "Synthèse" And F.Name <> "Choix Annee" Then

3) BUG : clic dans une cellule de la 1ere ligne des mois ==> plantage sur If R(0, 1) = "" Then



Dans dans If R(0, 1) = "" Then à quoi correspond ce R(0,1), une cellule ?

Ceci dit c'est une bonne initiative de vouloir améliorer une application.
Bonne continuation
Robert

 

[BOISGONTIER]

Re : [RÉSOLU + Améliorations en continu] Rendre le calendrier mensuel de David XLD pé

Bonsoir,

On peut déplacer les tableaux

Private Sub Worksheet_Activate()
  Set f = Sheets(ActiveSheet.Name)
  [a2:b367].ClearContents
  ligEvent = 2
  For m = 1 To 12
    mois = Format(DateSerial(2014, m, 1), "mmmm")
    Set AdrTab = Sheets(mois).Cells.Find("Lundi")
    For ligne = AdrTab.Row + 2 To AdrTab.Row + 2 + 10 Step 2
      For col = AdrTab.Column To AdrTab.Column + 6
        dt = Sheets(mois).Cells(ligne - 1, col)
        texte = Sheets(mois).Cells(ligne, col)
        If texte <> "" And dt <> "" Then
           f.Cells(ligEvent, 1) = dt
           f.Cells(ligEvent, 2) = texte
           ligEvent = ligEvent + 1
        End If
      Next col
    Next ligne
  Next m
End Sub

JB

 

[Herdet]

Re : [RÉSOLU + Améliorations en continu] Rendre le calendrier mensuel de David XLD pé

Bonsoir,

On peut déplacer les tableaux

Private Sub Worksheet_Activate()
  Set f = Sheets(ActiveSheet.Name)
  [a2:b367].ClearContents                                            <=== cellules en dur
  ligEvent = 2
  For m = 1 To 12
    mois = Format(DateSerial(2014, m, 1), "mmmm")        <=== ne pas bloquer sur 2014
......

JB

Bonsoir,

Désolé mais ça ne marche pas plus à cause des cellules en dur [a2:b367] et de l'année sur 2014
Test pour bug :
Feuille "SynthèseCmt" par exemple en colonne A, insérer 3 ou 4 colonnes
La macro cherche toujours A2:B367 et n'efface pas les anciens résultats.

Pourquoi persister à utiliser des références de cellules au lieu de noms définis, bien plus faciles à lire et qui sont toujours utilisables ?

Solution : nommer T_resultats =SynthèseCmt!$A:$B ou autre et utiliser

' definir le tableau T_resultats sur la feuille SynthèseCmt
Private Sub Worksheet_Activate()
   Annee = [ChoixAnnee]
   With ActiveSheet
      ligEvent = 1
      Set tr = Range("T_resultats")
      tr.ClearContents
      tr(ligEvent, 1) = "Date": tr(ligEvent, 2) = "Thème"
      ligEvent = ligEvent + 1
      For m = 1 To 12
        mois = Format(DateSerial(Annee, m, 1), "mmmm")
        Set AdrTab = Sheets(mois).Cells.Find("Lundi")
        For ligne = AdrTab.Row + 2 To AdrTab.Row + 2 + 10 Step 2
          For col = AdrTab.Column To AdrTab.Column + 6
            dt = Sheets(mois).Cells(ligne - 1, col)
            texte = Sheets(mois).Cells(ligne, col)
            If texte <> "" And dt <> "" Then
               tr(ligEvent, 1) = dt
               tr(ligEvent, 2) = texte
               ligEvent = ligEvent + 1
            End If
          Next col
        Next ligne
      Next m
   End With
End Sub

Cordialement
Robert

 

[Gen Rose]

Re : [RÉSOLU + Améliorations en continu] Rendre le calendrier mensuel de David XLD pé

Bonjour le Fil,

@Herdet: J'ai corrigé le bug en ajoutant A1:G1 dans le Range; le 0,1 signifie la cellule au-dessus. Dans le document, les utilisateurs sont renvoyés à la première case vide à remplir s'ils cliquent sur une cellule avec formule...Si... j'ai bien compris

J'ai renommé toutes mes feuilles avec Sh et ajusté selon ta suggestion Sh

Sub Raz()
  Dim Sh As Worksheet
  For Each Sh In Sheets
  If Sh.Name <> Sh_Synthese.Name And Sh.Name <> Sh_annee.Name Then _
      Sh.Range("A4:G4,A6:G6,A8:G8,A10:G10,A12:G12") = ""
  Next
End Sub

Personnellement, je suis trop novice pour comprendre l'amélioration, étant donné que le code Raz de Boigontier fonctionnait bien au départ...plus de rapidité? Je n'ai pas chronométré.

Concernant le souci du déplacement de tableau, je ne veux pas autoriser les gens à le déplacer (et pourquoi d'ailleurs?) car j'ai défini chaque zone d'impression. Pour le plaisir, je tente d'adapter ton code mais je n'y suis pas arrivé encore.

Merci à Si... et Boigontier de persévérer sur ce fil
Cdt,