Calendrier à carreaux pour plusieurs années


#21

calendrier mensuel santé préventive itss base.xlsm (78,1 Ko)


#22

Bonjour,

Voilà ma contribution,

sur l’onglet RdV, clic droit sur la cellule voulue en colonne C
une listbox s’ouvre avec les données du MENU (cette liste est dynamique)
clic sur une des données et elle se place sur la cellule et la listbox se ferme
Pour une deuxième donnée sur la même cellule, IDEM, la Nelle donnée s’ajoute

Pour le coloriage, voir avec les MFC

Code VBA

Option Explicit
Dim NbLigne As Integer 'Déclaration des variables pour le module
Dim ligne As Integer

Private Sub Worksheet_Activate()
Sheets(1).Unprotect
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = True
End Sub

Private Sub LstNom_Click()
  ActiveCell = ActiveCell.Value & " - " & Me.LstNom 'quand on clique sur une des données de la liste,
Me.LstNom.Visible = False               'elle se copie sur la cellule active en conservant les données présentes
End Sub                                 ' et la listbox se masque

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  If Not Application.Intersect(Target, Range("C2:C367")) Is Nothing Then 'sur clic droit dans une des cellules colonne C
    Cancel = True 'désactive le menu contextuel sur cette colonne (copier - coller- etc)
    Me.LstNom.Visible = True  'listbox visible
    
    Me.LstNom.Clear  'vide la listbox
    NbLigne = WorksheetFunction.CountA(Range("G:G")) + 20 'compte le Nb ligne du menu colonne G
      For ligne = 21 To NbLigne 'boucle sur les lignes
        LstNom.AddItem Cells(ligne, 7).Value 'ajoute les données sur la listbox
      Next ligne
  End If
  Me.LstNom.Top = Cells(ActiveWindow.ScrollRow, 3).Top + 100  'Fait suivre la listbox afin de la rendre visible en déroulant la feuille vers le bas
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Me.LstNom.Visible = False ' rend la listbox masquée après changement sur la sélection
End Sub

calendrier mensuel santé préventive itss base.xlsm (85,3 Ko)


#23

Re, Ma Poulette :grin:
(Je ne sais pas si c’est une injure, car je sais qu’au Québec, certaines expressions sont dés fois un peu salace)

Nelle Version avec colorisation et police en VBA

Ce qui change sur le module

Private Sub LstNom_Click()
  ActiveCell = ActiveCell.Value & " - " & Me.LstNom 'quand on clique sur une des données de la liste,
                                                    'elle se copie sur la cellule active en conservant les données présentes
                                                    
  If ActiveCell.Value Like "*Absente*" Or ActiveCell.Value Like "*Vacances*" Then 'colorisation de la cellule suivant données
    ActiveCell.Font.Name = "Calibri" 'Nom police
    ActiveCell.Font.Bold = True      'Gras = oui
    ActiveCell.Font.Italic = False   'Italique = non
    ActiveCell.Font.Size = 11        'Taille police =11
    ActiveCell.Interior.Color = RGB(255, 255, 255) 'Couleur cellule = blanc
    Else
    If ActiveCell.Value Like "*Réunion*" Then
      ActiveCell.Font.Name = "Baskerville Old Face"
      ActiveCell.Font.Bold = True
      ActiveCell.Font.Italic = True
      ActiveCell.Font.Size = 11
      ActiveCell.Interior.Color = RGB(191, 191, 191)
      Else
      If ActiveCell.Value Like "*Formation*" Then
        ActiveCell.Font.Name = "CASTELLAR"
        ActiveCell.Font.Bold = True
        ActiveCell.Font.Italic = False
        ActiveCell.Font.Size = 11
        ActiveCell.Interior.Color = RGB(255, 255, 255)
        Else
        If ActiveCell.Value Like "*Commande vaccin*" Then
          ActiveCell.Font.Name = "Verdana"
          ActiveCell.Font.Bold = True
          ActiveCell.Font.Italic = False
          ActiveCell.Font.Size = 11
          ActiveCell.Interior.Color = RGB(255, 255, 255)
          Else
          If ActiveCell.Value Like "*Férié*" Then
            ActiveCell.Font.Name = "Arial black"
            ActiveCell.Font.Bold = True
            ActiveCell.Font.Italic = False
            ActiveCell.Font.Size = 24
            ActiveCell.Interior.Color = RGB(255, 255, 255)
            Else
            ActiveCell.Font.Name = "Arial black"
            ActiveCell.Font.Bold = True
            ActiveCell.Font.Italic = False
            ActiveCell.Font.Size = 11
            ActiveCell.Interior.Color = RGB(255, 255, 255)
          End If
        End If
      End If
    End If
  End If
  ActiveCell.EntireRow.AutoFit 'hauteur auto de la ligne
  
Me.LstNom.Visible = False   ' et la listbox se masque
End Sub

calendrier mensuel avec taille et police.xlsm (88,1 Ko)


#24

Et bien non pour moi ce n’est pas une injure. C’est plutôt un petit mot coquin qui surprend et que l’on oublie pas. Lorsque que l’on pose sa cadidature pour un emploie vous êtes certain d’être rappeler pour un entrevue.

J’aurai aimé que le visuel du calendrier soit plus estétique.
Que l’information soie centrée et s’écrive sur trois ligne distinte.

calendrier mensuel avec taille et police SRV ITSS.xlsm (98,3 Ko)

SRV ITSS
SYLVIE
DR CAMIRÉ


#25

Bonjour,

Voilà la petite amélioration,
même marche à suivre, sinon que cela met chaque choix dans une ligne centrée
J’ai effectué les 3 premiers jours de Janvier
A toi de continuer (sélection droite, supprimer et ajouter la ou les mentions)
calendrier mensuel avec taille et police SRV ITSS.xlsm (96,3 Ko)


#26

Merci, je me demande comment vous faite pour que la liste du menu déroulant soit visible en plus gros? C’est vraiment conviviale.
Dans mon fichier de départ, elle était vraiment plus petite.


#27

Re,
Menu DEVELOPPEUR, clic qsur "Mode Création"
Clic droit sur la liste et agrandir la liste comme désirée
Recliquer sur “Mode Création” pour ôter la surbrillance :wink: