Calendrier annuel avec date de stage apparent

[Tophe2]

Bonjour le forum

Voilà je cherche à réaliser un calendrier annuel qui se modifie au fur et à mesure des années avec les fériés et week end.

Ce que je n'arrive pas à faire c'est d'y inclure de facon automatique les dates des différents stages organisés par nos services.

Par exemple un endroit sur la feuille excel ou l'on pourrait saisir les dates lieu et nature du stage pour que cela s'affiche "automatiquement" sur le calendrier pour avoir une vision globale de l'année en cours et des stages à venir car par moment plusieurs stages sur la même période.

Merci pour l'aide
Cordialement
Christophe.

 

[ferreourh]

Re : Calendrier annuel avec date de stage apparent

Bonjour le forum,

Merci pour toutes ces améliorations, j'utilise ce fichier pour gérer les réservations des salles de ma commune. Est'il possible de faire apparaitre le nom du lieu sur la premiére ligne du mois à la place de * , en effet les lieux sont placés différement dans chaque mois en fonction de l'ordre de création dans la liste.

Merci d'avance
_________________

Cordialement,
Jérôme

 

[Tophe2]

Re : Calendrier annuel avec date de stage apparent

Bonjour ferrourh et le forum

Essai comme ça, une adaptation du code de boisgontier :

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    nstage = 11      ' nombre de stages
    For m = 1 To 6   ' nombre de mois
      [C4:M35].Offset(, (m - 1) * (nstage + 2)).ClearContents
      [C4:M35].Offset(, (m - 1) * (nstage + 2)).Interior.ColorIndex = xlNone
      [C4:M35].Offset(, (m - 1) * (nstage + 2)).ClearComments
      [C38:M69].Offset(, (m - 1) * (nstage + 2)).ClearContents
      [C38:M69].Offset(, (m - 1) * (nstage + 2)).Interior.ColorIndex = xlNone
      [C38:M69].Offset(, (m - 1) * (nstage + 2)).ClearComments
    Next m

    'Stop
    Set planning = Sheets("calendrier")
    Set bd = Sheets("BD")
    For s = 1 To [Stage].Count
      If UCase(bd.Range("stage")(s)) <> "" Then
        If bd.Range("début")(s) <> "" And Year(bd.Range("début")(s)) = [an] Then
           jd = Day(bd.Range("début")(s))
           md = Month(bd.Range("début")(s))
           For c = 1 To 11
              If Cells(IIf(md < 7, 4, 38), (md - IIf(md < 7, 1, 7)) * (nstage + 2) + 3 + c) = "" Then
                colLibre = c
                Cells(IIf(md < 7, 4, 38), (md - IIf(md < 7, 1, 7)) * (nstage + 2) + 3 + c) = bd.Range("lieu")(s)   ' "*"
                Exit For
              End If
           Next c
           mf = Month(bd.Range("fin")(s))
           If mf <> md Then
             For c = 1 To 11
               If Cells(IIf(md < 7, 4, 38), (mf - IIf(mf < 7, 1, 7)) * (nstage + 2) + 3 + c) = "" Then
                colLibreFin = c
                Cells(IIf(md < 7, 4, 38), (mf - IIf(mf < 7, 1, 7)) * (nstage + 2) + 3 + c) = bd.Range("lieu")(s) ' "*"
                Exit For
               End If
             Next c
           End If
           With Cells(IIf(md < 7, 4, 38) + jd, (md - IIf(md < 7, 1, 7)) * (nstage + 2) + 3 + colLibre)
           .AddComment
           temp = bd.Range("lieu")(s) & Chr(10) & bd.Range("thème")(s)
           .Comment.Text Text:=temp
           .Comment.Shape.TextFrame.AutoSize = True
           .Comment.Visible = False 'True
           End With
           For d = bd.Range("début")(s) To bd.Range("fin")(s)
             j = Day(d)
             m = Month(d)
             If Year(d) = [an] Then
               If m = md Then
                 Cells(IIf(m < 7, 4, 38) + j, (m - IIf(m < 7, 1, 7)) * (nstage + 2) + 3 + colLibre) = bd.Range("stage")(s)
                 Cells(IIf(m < 7, 4, 38) + j, (m - IIf(m < 7, 1, 7)) * (nstage + 2) + 3 + colLibre).Interior.ColorIndex = 36
               Else
                 Cells(IIf(m < 7, 4, 38) + j, (m - IIf(m < 7, 1, 7)) * (nstage + 2) + 3 + colLibreFin) = bd.Range("stage")(s)
                 Cells(IIf(m < 7, 4, 38) + j, (m - IIf(m < 7, 1, 7)) * (nstage + 2) + 3 + colLibreFin).Interior.ColorIndex = 36
               End If
            End If
          Next d
        End If
     End If
   Next s
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Address = "$A$2" Then
      Worksheet_Activate
    End If
End Sub

Par contre toujours pas trouvé de solution pour l'année.
Cordialement
Christophe.

 

[ferreourh]

Re : Calendrier annuel avec date de stage apparent

Merci Christophe c'est parfait.
Jérôme

 

[amocco]

Re : Calendrier annuel avec date de stage apparent

Bonjour Monique ,
Je recherchais un calendrier comme le tien . Par contre je voudrais rajouter 2 colonnes chaque mois .
J ai un peu de mal pourrais tu m'expliquer comment faire .
merci

 

[amocco]

Re : Calendrier annuel avec date de stage apparent

Re,

Le fichier modifié.
Nature et lieu : pas Recherchev() mais formule matricielle, à valider en appuyant simultanément sur ctrl, maj et entrée.
Dans ton exemple, tu as des thèmes différents pour chacun des stages (je ne comprends pas trop mais ça ne fait rien)
Si tu as le même thème, tu lui donnes un libellé différent, du genre "Appro 1", "Appro 2"

j AI oublié c'est le fichier CalendStagesV2.zip qui m'interresse .