XL 2016 Associer une cellule date à une cellule texte

[nczar]

Bonjour,
A l'aide de tutos, j'ai adapté un calendrier qui affiche les jours d'un mois avec sous chaque jour du mois, une cellule pour y mettre du texte.
Je peux changer automatiquement de mois et/ou d'année.
Mon problème, c'est que lorsque je change de mois, le texte inscrit le mois précédent reste présent. Comment faire pour que ce ne soit pas le cas, pour que à chaque jour d'un mois et/ou d'une année le texte inscrit dans la cellule en-dessous de la date lui corresponde bien.
Merci pour tout aide.

 

[mapomme]

Bonjour @nczar,
Bienvenue sur XLD

Il faudrait joindre le classeur à votre question.
Le classeur devra être anonymisé pour respecter le RGPD.

A plus.

 

[nczar]

Merci pour cette réponse. Mais comment anonymisé le classeur ?

 

[chris]

Bonjour à tous

Il faut que le texte ait pour source une BDD et que le calendrier affiche les infos de cette BD en fonction du mois choisi

En conclusion le calendrier contient des formules et la saisie se fait dans la BDD

 

[mapomme]

Re,

Vite fait, un exemple vraiment "minimaliste" avec très peu de code VBA pour montrer ce qu'on pourrait faire. Le code est dans le module de la feuille "Cal":

Modifiez l'année ou le mois ou encore les notes.
Les modifications sont conservées dans la feuille Bdd en temps réel.
Néanmoins, Il faut bien sûr enregistrer le classeur quand on le referme sinon les modifs de la session seront perdues (comportement qu'on pourrait changer pour une vraie sauvegarde en temps réel).

Certaines cellules ne sont pas sélectionnables (pour ne pas les modifier même par inadvertance). Ce sont les cellules des jours et les cellules des notes correspondant à des jours inexistants au sein du mois courant.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim col&, quoi, i&
   If Intersect(Target, Columns("a:b")) Is Nothing Then Exit Sub
   If Range("b1") = "" Or Range("b2") = "" Then Exit Sub

   On Error GoTo FIN
   Application.EnableEvents = False: Application.ScreenUpdating = False
   If Range("a5") <> "" Then
      quoi = Format(Range("a5"), "mmyyyy")
      col = Application.Match(quoi, Sheets("Bdd").Rows(1), 0)
      Range("b5").Resize(31).Copy Sheets("Bdd").Cells(2, col)
   End If
   quoi = Format(DateSerial([b1], [b2], 1), "mmyyyy")
   col = Application.Match(quoi, Sheets("Bdd").Rows(1), 0)
   Sheets("Bdd").Cells(2, col).Resize(31).Copy Range("b5")

   Range("a5").Resize(31).ClearContents
   Range("a5") = DateSerial([b1], [b2], 1)
   For i = 2 To Day(DateSerial([b1], [b2] + 1, 0)): Range("a5").Offset(i - 1) = Range("a5") + i - 1: Next
FIN:
   Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n&, xrg As Range
   n = Application.Count(Range("a5:a35"))
   If n = 31 Then
      If Not Intersect(Target, Range("a5").Resize(31)) Is Nothing Then Range("a3").Select: Beep
   Else
      Set xrg = Range("b5").Offset(n).Resize(31 - n, 1)
      Set xrg = Union(xrg, Range("a5").Resize(31))
      If Not Intersect(Target, xrg) Is Nothing Then Range("a3").Select: Beep
   End If
End Sub

 

[mapomme]

Merci pour cette réponse. Mais comment anonymisé le classeur ?

Re,

Il faut juste vérifier que le classeur ne comporte aucune donnée personnelle de type nom, prénom, téléphone, adresse, adresse mail, etc.

S'il y en a, les remplacer par des infos bidons: Nom1, Nom2, Nom3, 9999999999, rue de mapomme à Trifouillis les Oies ,toto@titi.xyz... On peut tout imaginer

 

[nczar]

Merci chris pour la réponse. C'est une piste que je vais essayer de suivre, même si à70 ans passés cela devient difficile, vu que la pratique est bien lointaine.
En tout cas voici le fichier.

Re,

Vite fait, un exemple vraiment "minimaliste" avec très peu de code VBA pour montrer ce qu'on pourrait faire. Le code est dans le module de la feuille "Cal":

Modifiez l'année ou le mois ou encore les notes.
Les modifications sont conservées dans la feuille Bdd en temps réel.
Néanmoins, Il faut bien sûr enregistrer le classeur quand on le referme sinon les modifs de la session seront perdues (comportement qu'on pourrait changer pour une vraie sauvegarde en temps réel).

Certaines cellules ne sont pas sélectionnables (pour ne pas les modifier même par inadvertance). Ce sont les cellules des jours et les cellules des notes correspondant à des jours inexistants au sein du mois courant.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim col&, quoi, i&
   If Intersect(Target, Columns("a:b")) Is Nothing Then Exit Sub
   If Range("b1") = "" Or Range("b2") = "" Then Exit Sub

   On Error GoTo FIN
   Application.EnableEvents = False: Application.ScreenUpdating = False
   If Range("a5") <> "" Then
      quoi = Format(Range("a5"), "mmyyyy")
      col = Application.Match(quoi, Sheets("Bdd").Rows(1), 0)
      Range("b5").Resize(31).Copy Sheets("Bdd").Cells(2, col)
   End If
   quoi = Format(DateSerial([b1], [b2], 1), "mmyyyy")
   col = Application.Match(quoi, Sheets("Bdd").Rows(1), 0)
   Sheets("Bdd").Cells(2, col).Resize(31).Copy Range("b5")

   Range("a5").Resize(31).ClearContents
   Range("a5") = DateSerial([b1], [b2], 1)
   For i = 2 To Day(DateSerial([b1], [b2] + 1, 0)): Range("a5").Offset(i - 1) = Range("a5") + i - 1: Next
FIN:
   Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n&, xrg As Range
   n = Application.Count(Range("a5:a35"))
   If n = 31 Then
      If Not Intersect(Target, Range("a5").Resize(31)) Is Nothing Then Range("a3").Select: Beep
   Else
      Set xrg = Range("b5").Offset(n).Resize(31 - n, 1)
      Set xrg = Union(xrg, Range("a5").Resize(31))
      If Not Intersect(Target, xrg) Is Nothing Then Range("a3").Select: Beep
   End If
End Sub

Re,

Vite fait, un exemple vraiment "minimaliste" avec très peu de code VBA pour montrer ce qu'on pourrait faire. Le code est dans le module de la feuille "Cal":

Modifiez l'année ou le mois ou encore les notes.
Les modifications sont conservées dans la feuille Bdd en temps réel.
Néanmoins, Il faut bien sûr enregistrer le classeur quand on le referme sinon les modifs de la session seront perdues (comportement qu'on pourrait changer pour une vraie sauvegarde en temps réel).

Certaines cellules ne sont pas sélectionnables (pour ne pas les modifier même par inadvertance). Ce sont les cellules des jours et les cellules des notes correspondant à des jours inexistants au sein du mois courant.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim col&, quoi, i&
   If Intersect(Target, Columns("a:b")) Is Nothing Then Exit Sub
   If Range("b1") = "" Or Range("b2") = "" Then Exit Sub

   On Error GoTo FIN
   Application.EnableEvents = False: Application.ScreenUpdating = False
   If Range("a5") <> "" Then
      quoi = Format(Range("a5"), "mmyyyy")
      col = Application.Match(quoi, Sheets("Bdd").Rows(1), 0)
      Range("b5").Resize(31).Copy Sheets("Bdd").Cells(2, col)
   End If
   quoi = Format(DateSerial([b1], [b2], 1), "mmyyyy")
   col = Application.Match(quoi, Sheets("Bdd").Rows(1), 0)
   Sheets("Bdd").Cells(2, col).Resize(31).Copy Range("b5")

   Range("a5").Resize(31).ClearContents
   Range("a5") = DateSerial([b1], [b2], 1)
   For i = 2 To Day(DateSerial([b1], [b2] + 1, 0)): Range("a5").Offset(i - 1) = Range("a5") + i - 1: Next
FIN:
   Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n&, xrg As Range
   n = Application.Count(Range("a5:a35"))
   If n = 31 Then
      If Not Intersect(Target, Range("a5").Resize(31)) Is Nothing Then Range("a3").Select: Beep
   Else
      Set xrg = Range("b5").Offset(n).Resize(31 - n, 1)
      Set xrg = Union(xrg, Range("a5").Resize(31))
      If Not Intersect(Target, xrg) Is Nothing Then Range("a3").Select: Beep
   End If
End Sub

Bonjour,

Merci beaucoup d'avoir pris le temps de me proposer une solution avec VBA. Mais cela ne correspond pas trop à ce que je voulais. Mais, mea culpa, je n'avais pas joint mon fichier.
Cordialement.

 

[JHA]

Bonjour à tous,

Ton calendrier fonctionne très bien
Si tu veux garder les notes, il faut mettre un calendrier par onglets soit 12 onglets.
Si tu veux effacer les notes de ce calendrier sans VBA, tu filtres les "0" puis tu sélectionnes "B6:H16" et supprimer mais tu as perdu les données.
La colonne "A" peut être masquée.

JHA

 

[JHA]

Bonjour à tous,

Tu peux aussi copier/collage spécial valeur et format dans un autre onglet pour garder les données.

JHA

 

[nczar]

Bonjour à tous,

Tu peux aussi copier/collage spécial valeur et format dans un autre onglet pour garder les données.

JHA

Bonjour à tous,

Merci beaucoup, JHA, pour ces réponses. Vu que je veux garder les données, que je veux en mettre d'autres chaque mois, je vais donc faire un onglet par mois. J'avais déjà lu que c'était une solution, mais j'espérais qu'il y en avait une autre.
Cordialement.