Insérer automatiquement des évenements dans un calendrier Excel

[Vode]

Bonjour à tous,

Je voudrais savoir s’il est possible d’insérer les évènements d’une feuille Excel dans un calendrier Excel. J’ai une base avec des données sur un onglet et j’aimerai que ces données soit transférées directement dans un calendrier existant dans les onglets suivants dès que j’ajoute une date.

J’aimerai aussi que 2 évènements (ou plus) ayant la même date puissent être intégrés dans la même case Excel du calendrier. L’évènement serait transféré dans le calendrier dès que j’ajoute une date et si je modifie cette date qu’il soit déplacé dans la bonne case du calendrier.

Et si possible, mais c’est secondaire, que les données soient concatenées (mais je peux le faire avec une formule toute bête) et que les données concatenées conservent leur couleur et/ou leur police en gras.

J’ai mis un exemple pour le mois de janvier, mais je pense que ça va être un peu compliqué.

Calendrier.xlsx (44,0 Ko)

[Mimimathy]

Bonjour,

Pour une date, pas de soucis pour reproduire les formats, mais si deux dates, les formats ne pourront pas rester, ou alors, on rentre dans une machinerie énorme.
Idem pour le chgt de date, la nouvelle date sera prise en compte, mais les données de l’ancienne seront retirées manuellement.
Par clic droit sur la date de la ligne concernée, les données se mettent en place

A tester en premier lieu, si cela peut convenir, avant que je me lance dans des macros plus poussées.
Calendrier.xlsm (60,8 Ko)

[Vode]

C’est très bien, le test est concluant. Merci.

Les macros plus poussées dont tu parles, c’est pour conserver les formats avec 2 dates ? Et pour le retrait de l’ancienne date ?

Si c’est ça pour le format ne te casse pas la tête, sauf si tu le souhaites, ça me convient bien comme ça. A la rigueur si tu peux faire quelque chose pour le retrait de l’ancienne date, je préfère.

Mais franchement, c’est top ce que tu as fait, un grand merci, t’es trop fort.

Juste une petite question, quand le calendrier changera d’une année à l’autre, est-ce qu’il faudra que je fasse évoluer la macro ? Je pense que non.

[Mimimathy]

Re

Alors regarde cette version
le clic droit pour ajouter le texte, avec coloration de la date
le double clic sur la date pour ôter la coloration et le texte dans le mois concerné

et une liste déroulante pour visionner le mois

Calendrier.xlsm (82,7 Ko)

Pour le Changement d’année pas de soucis avec la macro, mais surement avec ton calendrier qui n’est pas dynamique

[Vode]

Pour le calendrier, je le génère automatiquement chaque année, je remplacerai juste les anciennes feuilles par les nouvelles manuellement. (il faudra que j’ajoute ton bouton “retour base”)

Le résultat est parfait. Juste un petit détail, si tu peux faire quelque chose. Quand 2 évènements sont copiés dans la même cellule, est-il possible de séparer les 2 évènements par un saut de ligne dans la même case.

[Mimimathy]

Re,

A tester
Calendrier.xlsm (83,2 Ko)

[Vode]

Le test n’est pas concluant, le saut de ligne se place avant les 2 évènements, pas entre les 2 évènements.

Tu vas me tuer avec mes demandes, est-ce que tu peux juste m’ajouter une colonne “observations” placée entre la colonne “devise” et “date”. Je suis un boulet, j’aurai dû le prévoir avant.

Encore merci pour le temps que tu passes sur ma demande.

[Mimimathy]

Re,

place un classeur exemple, contenant toutes les données représentant ta configuration finale

C’est le BABA, si tu n’est pas adepte des macros , cela permet de ne pas revenir 50 fois à des modifs inutiles au départ

[Vode]

Tu as raison, j’aurais dû y penser avant. Je viens de regarder ta dernière mouture. Donc j’ai ajouté la colonne, elle est bien prise en compte, ça marche et j’ai déplacé l’espace au bon endroit entre 2 évènements.

Par contre, le style d’écriture se met n’importe comment. J’ai mis un exemple dans le calendrier.

En agissant sur ce bout de code, j’ai vu que ça pouvait jouer sur le style d’écriture mais je m’y perds, je tâtonne sans comprendre ce que je fais.

Formater Sheets(feuille).Cells(lig, col).Offset(1, 0), ActiveCell.Offset(0, -4), 0
Formater Sheets(feuille).Cells(lig, col).Offset(1, 0), ActiveCell.Offset(0, -3), Len(ActiveCell.Offset(0, -2)) + 1
Formater Sheets(feuille).Cells(lig, col).Offset(1, 0), ActiveCell.Offset(0, -2), Len(ActiveCell.Offset(0, -3)) + 2
Formater Sheets(feuille).Cells(lig, col).Offset(1, 0), ActiveCell.Offset(0, -1), Len(ActiveCell.Offset(0, -4)) + Len(ActiveCell.Offset(0, -2)) + 5

Calendrier.xlsm (79,8 Ko)

[Vode]

Super, ça fonctionne bien après quelques essais. Encore merci pour ton aide

Si tu as le temps, je veux bien une petite explication sur le fonctionnement des lignes de code notamment “len(…”

[Mimimathy]

Re,

Ok, je te fait cela demain ou après demain (suivant mes obligations) pour toi et pour le forum, une explication des macros du montage

et pour la suite, je te ferai un montage avec le calendrier dynamique

[Mimimathy]

Re,

Macro avec commentaire

Option Explicit
'Déclaration des variables
Dim lig%, col%, Nb%
Dim mois, annee, feuille, dDate, RdV$, temp$, monText$, F$
Dim Sh As Worksheet

'Macro pour récupèrer le format de la cellule et la Formater
Private Sub Formater(RngDest As Range, RngSce As Range, n As Integer)
  Dim d%, i%
  Dim Tb
  Tb = Split(RngSce)
  'Récupère dans un tableau les mots de la cellule
  For i = 0 To UBound(Tb) 'Boucle sur tous les caractères du mots
    d = d + 1
    'Mémorise les styles de police, taille, couleur, soulignement
    With RngDest.Characters(d + n, d + n + Len(Tb(i))).Font
      .FontStyle = RngSce.Characters(d, 1).Font.FontStyle
      .Size = RngSce.Characters(d, 1).Font.Size
      .Color = RngSce.Characters(d, 1).Font.Color
      .Underline = RngSce.Characters(d, 1).Font.Underline
    End With
    d = d + Len(Tb(i))
  Next i
End Sub

'Pour l'ouverture de l'onglet de la liste déroulante
Private Sub ComboBox1_Change()
  On Error Resume Next
  F = ComboBox1
  Sheets(F).Select
End Sub

'Effacement d'une donnée par double clic
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  'Récupère le texte en regard de la date
  monText = ActiveCell.Offset(0, -4) & " : " & ActiveCell.Offset(0, -3) & " - " & ActiveCell.Offset(0, -2) & " - " & ActiveCell.Offset(0, -1)
  dDate = ActiveCell 'Date de la donnée
  mois = Month(ActiveCell) 'Mois de la donnée
  If Len(mois) = 1 Then mois = "0" & mois 'Si le mois est inférieur à 10 je rajoute un "0" devant le chiffre
  annee = Year(ActiveCell) 'Année de la donnée
  feuille = annee & "-" & mois 'Nom de l'onglet
    With Sheets(feuille)
      For lig = 6 To 16 Step 2 'Boucle toutes les 2 lignes
        For col = 3 To 9 'Boucle sur les colonnes
          If Sheets(feuille).Cells(lig, col).Value = dDate Then 'Si la date est trouvée
            'Je remplace monText par rien
            Sheets(feuille).Cells(lig, col).Offset(1, 0) = Replace(Sheets(feuille).Cells(lig, col).Offset(1, 0), monText, "")
            Exit For 'et je sort de la boucle
          End If
        Next col
      Next lig
    End With
  ActiveCell.Interior.Color = RGB(255, 255, 255) 'ôte la couleur de la cellule date
End Sub
'Ajoute la donnée par clic droit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  If Not Application.Intersect(Target, Range("E2:E65000")) Is Nothing Then 'sur clic droit dans une des cellules colonne D
    Cancel = True
    ActiveCell.Interior.Color = RGB(198, 224, 180) 'colorise la cellule date
    Nb = 0 '
    dDate = ActiveCell
    mois = Month(ActiveCell)
    If Len(mois) = 1 Then mois = "0" & mois
    annee = Year(ActiveCell)
    feuille = annee & "-" & mois
      With Sheets(feuille)
        For lig = 6 To 16 Step 2
          For col = 3 To 9
            If Sheets(feuille).Cells(lig, col).Value = dDate Then
              With Worksheets("base")
                If Sheets(feuille).Cells(lig, col).Offset(1, 0) <> "" Then 'Si la cellule correspondant à la date n'est pas vide
                  temp = Sheets(feuille).Cells(lig, col).Offset(1, 0).Value 'Je mémorise sa donnée
                  Nb = 1
                End If
                'J 'inscrit le texte concaténé dans la cellule décalée d'une ligne de la date correspondante
                Sheets(feuille).Cells(lig, col).Offset(1, 0) = ActiveCell.Offset(0, -4) & " : " & ActiveCell.Offset(0, -3) & " - " & ActiveCell.Offset(0, -2) & " - " & ActiveCell.Offset(0, -1)
                'J'envoi dans la macro FORMATER la données de la cellule colonne A (RngSce) et la colle dans la cellule de la date (RngDest)avec le format
                Formater Sheets(feuille).Cells(lig, col).Offset(1, 0), ActiveCell.Offset(0, -4), 0
                'Idem pour la colonne B, mais avec le format qui sera actif après le Nb de caractères (Len=NbCar) de la colonne A + 3 pour " : "
                Formater Sheets(feuille).Cells(lig, col).Offset(1, 0), ActiveCell.Offset(0, -3), Len(ActiveCell.Offset(0, -4)) + 3
                'Idem que ci-dessus + 6 pour " : " (3 caract.) et " - " (3 caract.)
                Formater Sheets(feuille).Cells(lig, col).Offset(1, 0), ActiveCell.Offset(0, -2), Len(ActiveCell.Offset(0, -3)) + Len(ActiveCell.Offset(0, -4)) + 6
                Formater Sheets(feuille).Cells(lig, col).Offset(1, 0), ActiveCell.Offset(0, -1), Len(ActiveCell.Offset(0, -4)) + Len(ActiveCell.Offset(0, -3)) + Len(ActiveCell.Offset(0, -2)) + 9
                  If Nb = 1 Then 'Si la cellule n'est pas vide, je colle la donnée et l'ancienne donnée (Temp) avec un retour à la ligne et un interligne
                    Sheets(feuille).Cells(lig, col).Offset(1, 0).Value = Sheets(feuille).Cells(lig, col).Offset(1, 0).Value & Chr(10) & Chr(10) & temp
                    Nb = 0
                  End If
              End With
              Exit For
            End If
          Next col
        Next lig
      End With
  End If
Sheets("Base").Activate
End Sub

[Vode]

Merci pour ton aide précieuse et tes explications.

[Vode]

Holalalala, c’est dingue ce que tu as fait !!! Le résultat est juste parfait. ENORME merci, franchement, c’est TOP.