Erreur 13 avec lancement d'un userform

Le 12/01/2021 à 09:52

Bonjour,

J'ai un bug avec le message suivant : erreur d'éxecution incompatibilité de type

uniquement sur une date et sur une seule personne : samedi 16 janvier

Je ne comprends pas pourquoi ca bug seulement sur cet emplacement précis et pour cette personne précise

c1 c2

si je fais debuggage, je tombe ici

c3

avec le message en survol sur Load Userform_notes : Userform_notes<variable objet ou variable de bloc with non définie>

Pourriez vous m'aider svp ?

Est-ce que le problème vient de la feuille active "Calendrier" ou de l'userform ?

Voici le code de la feuille en cours :

Option Explicit

Private Sub ComboBox1_Change() 'au changement de résident
Range("a1") = ComboBox1.Value 'affectation du resident à A1
Call generer_calendrier ' appel de la fonction generer_calendrier pour créer le tableau
End Sub

Sub generer_calendrier()
Dim plage2 As Range: Dim cell As Variant: Dim col1 As Integer: Dim commrepas As String
    Dim heure_retour As String: Dim nom1 As String: Dim Annee As Integer: Dim comm1 As String: Dim num_ligne As Integer: Dim derniere_ligne As Integer: Dim nb1 As Integer: Dim ligne As Integer: Dim i As Integer
    Dim Mois As Integer: Dim nb_jours As Integer: Dim colonne As Integer: Dim date_du_jour As Date: Dim Jour As Integer: Dim Date_rec As Date: Dim Myvaleur As String: Dim no_couleur As Integer
    Dim BoEcran As Boolean, BoBarre As Boolean, BoEvent As Boolean, BoSaut As Boolean: Dim iCalcul As Integer
    BoEcran = Application.ScreenUpdating: BoBarre = Application.DisplayStatusBar: iCalcul = Application.Calculation: BoEvent = Application.EnableEvents: BoSaut = ActiveSheet.DisplayPageBreaks
    Application.ScreenUpdating = False: Application.DisplayStatusBar = False: Application.Calculation = xlManual: Application.EnableEvents = False: ActiveSheet.DisplayPageBreaks = False:
    Range("a3:aj33").ClearComments

    Annee = 2021: nom1 = ComboBox1.Value 'affectation 2021 à Année et prénom du résident à nom1
    num_ligne = 0: heure_retour = "": comm1 = "": TextBox1.Value = "": TextBox2.Value = "" 'initialisation à vide des variables heure_retour, comm1 et des textbox1 et textbox2
    Sheets("Calendrier").Range("g36") = "" 'effacer liste notes dans G36
    Range("A3:aj33").ClearContents 'effacer planning
    Range("d31:f31").Borders.LineStyle = Range("A1").Borders.LineStyle: Range("d31:f31").Interior.color = Range("A1").Interior.color 'format 29 fevrier
    'Selon le nom du resident, donner valeurs à numero de ligne  et heure du retour
    Select Case nom1
        Case "Daniel": num_ligne = 57: heure_retour = "Quitte le FH vers 17h - Retour le matin vers 11h"
        Case "Thibaut": num_ligne = 66: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 17h"
        Case "Caroline": num_ligne = 75: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 21h"
        Case "Arnaud": num_ligne = 84: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 17h"
        Case "Deborah": num_ligne = 93: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 17h"
        Case "Marjorie": num_ligne = 102: heure_retour = "Quitte le FH vers 17h - Retour au FH à 8h"
        Case "Theo": num_ligne = 111: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 20h"
        Case "Thalia": num_ligne = 120: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 17h"
        Case "Andrew": num_ligne = 129: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 17h"
        Case "Aude": num_ligne = 138: heure_retour = "Quitte le FH vers 18h - Retour au FH la veille à 21h"
        Case "Quentin": num_ligne = 147: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 21h"
        Case "Amandine": num_ligne = 156: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 20h"
        Case "Selim": num_ligne = 165: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 17h"
        Case "Wilfried": num_ligne = 174: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 8h"
        Case "Krystopher": num_ligne = 183: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 17h"
        Case "Kelvine": num_ligne = 191: heure_retour = "Quitte le FH vers 17h - Retour au FH la veille à 17h"
        Case "Melanie": num_ligne = 198
        Case "Frederique": num_ligne = 205: heure_retour = "Quitte le FH vers 14h - Retour au FH à 12h"
    End Select

    nb1 = 0 'remise de la variable nb1 à 0 pour calculer le n° de colonne du mois
    For Mois = 1 To 12 'Boucle MOIS
        nb_jours = Day(DateSerial(Annee, Mois + 1, 1) - 1): colonne = Mois * 2 - 1 + nb1 'affectation du nb de jours dans le mois et du n° de colonne du mois
        For Jour = 1 To nb_jours 'Boucle JOURS
            date_du_jour = DateSerial(Annee, Mois, Jour) 'affectation de la date du jour à date_du_jour avec les variables Annee, mois, Jour
            Cells(Jour + 2, colonne) = date_du_jour 'saisie de la date du jour dans la cellule de la 1ère colonne
            Date_rec = Cells(Jour + 2, colonne) 'garder en memoire la date du jour dans la variable Date_rec
            Set plage2 = ThisWorkbook.Worksheets("Stats repas").Range("e55:nr55") 'recherche le n° de colonne de la date du jour dans la feuille Stats repas
            For Each cell In plage2
                 If cell.Value = CDate(Date_rec) Then
                    col1 = cell.Column: Exit For
                  End If
            Next cell
            If nom1 = "Melanie" Or nom1 = "Kelvine" Or nom1 = "Frederique" Then 'Si foyer de vie
                If ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne, col1).Value = "x" Or ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne, col1).Value = "x>" Or ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne, col1).Value = "x<" Then
                    Cells(Jour + 2, colonne + 2) = "FH" 'Saisir FH si présent au FH dans la dernière colonne du jour
                End If
                If ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne + 4, col1).Value <> "" Or ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne + 5, col1).Value <> "" Then
                        commrepas = LCase(ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne + 4, col1).Value) & "-" & UCase(ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne + 5, col1).Value)
                        With Cells(Jour + 2, colonne + 2) 'Insertion commentaire si repas annulé
                            .AddComment: .Comment.Visible = False: .Comment.Text Text:=commrepas
                            With .Comment.Shape
                                .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 6: .OLEFormat.Object.Interior.ColorIndex = 15: .TextFrame.Characters.Font.ColorIndex = 54: .TextFrame.Characters.Font.Bold = True: .OLEFormat.Object.Font.Name = "Book Antiqua"
                            End With
                        End With
                End If
            Else ' si travailleurs alors saisir valeur de la ligne Présences FH ESAT de la feuille Stats repas dans la dernière colonne du jour
                Cells(Jour + 2, colonne + 2) = ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne, col1).Value
                If ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne + 5, col1).Value <> "" Or ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne + 6, col1).Value <> "" Then
                        commrepas = LCase(ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne + 5, col1).Value) & "-" & UCase(ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne + 6, col1).Value)
                        With Cells(Jour + 2, colonne + 2) 'Insertion commentaire si repas annulé
                            .AddComment: .Comment.Visible = False: .Comment.Text Text:=commrepas
                            With .Comment.Shape
                                .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 6: .OLEFormat.Object.Interior.ColorIndex = 15: .TextFrame.Characters.Font.ColorIndex = 54: .TextFrame.Characters.Font.Bold = True: .OLEFormat.Object.Font.Name = "Book Antiqua"
                            End With
                        End With
                End If
            End If
            If Weekday(date_du_jour) = 2 Then  'Si weekend insérer infobulle s1 par ex
                If Cells(Jour + 2, colonne).Comment Is Nothing Then
                    With Cells(Jour + 2, colonne)
                        .AddComment: .Comment.Visible = True: .Comment.Text Text:="s" & Format(date_du_jour, "WW") - 1:
                        With .Comment.Shape
                            .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 6: .OLEFormat.Object.Interior.ColorIndex = 3: .TextFrame.Characters.Font.ColorIndex = 2: .TextFrame.Characters.Font.Bold = True: .OLEFormat.Object.Font.Name = "Book Antiqua"
                        End With
                    End With
                Else
                    With Cells(Jour + 2, colonne)
                        .Comment.Visible = True: .Comment.Text Text:="s" & Format(date_du_jour, "WW") - 1
                        With .Comment.Shape
                            .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 6: .OLEFormat.Object.Interior.ColorIndex = 3: .TextFrame.Characters.Font.ColorIndex = 2: .TextFrame.Characters.Font.Bold = True: .OLEFormat.Object.Font.Name = "Book Antiqua"
                        End With
                    End With
                End If
            End If
            'Couleur de fond des weekends
            If Weekday(date_du_jour) = 1 Or Weekday(date_du_jour) = 7 Then
                Cells(Jour + 2, colonne).Interior.color = RGB(192, 224, 255): Cells(Jour + 2, colonne + 1).Interior.color = RGB(255, 255, 255): Cells(Jour + 2, colonne + 2).Interior.color = RGB(255, 255, 255)
            Else
                Cells(Jour + 2, colonne).Interior.color = RGB(255, 255, 255): Cells(Jour + 2, colonne + 1).Interior.color = RGB(255, 255, 255): Cells(Jour + 2, colonne + 2).Interior.color = RGB(255, 255, 255)
            End If

            'BORDURES
            With Cells(Jour + 2, colonne).Borders(xlEdgeBottom) 'Gauche
                .LineStyle = xlContinuous: .Weight = xlHairline
            End With
            With Cells(Jour + 2, colonne).Borders(xlEdgeRight)
                .LineStyle = xlContinuous: .Weight = xlHairline
            End With
            With Cells(Jour + 2, colonne).Borders(xlEdgeLeft)
                .LineStyle = xlContinuous: .Weight = xlThin
            End With
            If Weekday(date_du_jour) = 1 Then 'Si dimanche
                With Cells(Jour + 2, colonne).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous: .Weight = xlMedium
                End With
            End If
            If Jour = nb_jours Then
                With Cells(Jour + 2, colonne).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous: .Weight = xlThin
                End With
            End If
            With Cells(Jour + 2, colonne + 1).Borders(xlEdgeBottom) 'Centre
                .LineStyle = xlContinuous: .Weight = xlHairline
            End With
            With Cells(Jour + 2, colonne + 1).Borders(xlEdgeRight)
                .LineStyle = xlContinuous: .Weight = xlHairline
            End With
            If Weekday(date_du_jour) = 1 Then 'Si dimanche
                With Cells(Jour + 2, colonne + 1).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous: .Weight = xlMedium
                End With
            End If
            If Jour = nb_jours Then
                With Cells(Jour + 2, colonne + 1).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous: .Weight = xlThin
                End With
            End If
            With Cells(Jour + 2, colonne + 2).Borders(xlEdgeBottom) 'Droite
                .LineStyle = xlContinuous: .Weight = xlHairline
            End With
            If Mois = 12 Or Jour > 28 Then
                With Cells(Jour + 2, colonne + 2).Borders(xlEdgeRight)
                    .LineStyle = xlContinuous: .Weight = xlThin
                End With
            End If
            If Weekday(date_du_jour) = 1 Then 'Si dimanche
                With Cells(Jour + 2, colonne + 2).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous: .Weight = xlMedium
                End With
            End If
            If Jour = nb_jours Then
                With Cells(Jour + 2, colonne + 2).Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous: .Weight = xlThin
                End With
            End If

            'Affichage des données
            derniere_ligne = Sheets("BD_CAL").Range("A65000").End(xlUp).Row 'creation variable tableau pour les notes avec les données de la feuille BD_CAL
            If derniere_ligne > 1 Then 'Si BD non vide
                Dim tab_bd(): ReDim tab_bd(derniere_ligne - 2, 4)
                For i = 0 To UBound(tab_bd, 1)
                    tab_bd(i, 0) = Sheets("BD_CAL").Cells(i + 2, 1): tab_bd(i, 1) = Sheets("BD_CAL").Cells(i + 2, 2): tab_bd(i, 2) = Sheets("BD_CAL").Cells(i + 2, 3)
                    tab_bd(i, 3) = Sheets("BD_CAL").Cells(i + 2, 4): tab_bd(i, 4) = Sheets("BD_CAL").Cells(i + 2, 5)
                Next
                For i = 0 To UBound(tab_bd, 1) 'Affichage des données de BD_CAL dans Calendrier (colonne du milieu avec ou sans infobulle et textbox1
                    If tab_bd(i, 0) = date_du_jour And tab_bd(i, 4) = nom1 Then 'si date du jour et resident séléctionné
                        Cells(Jour + 2, colonne + 1) = tab_bd(i, 1) 'alors saisir dans la colonne du milieu les initiales de la Note
                            If TextBox1.Value = "" Then 'ajouter note à TextBox1
                                If tab_bd(i, 3) <> "" Then
                                    TextBox1.Value = " - " & tab_bd(i, 0) & " (" & tab_bd(i, 1) & " )" & " " & tab_bd(i, 3)
                                Else
                                    TextBox1.Value = " - " & tab_bd(i, 0) & " (" & tab_bd(i, 1) & " )"
                                End If
                            Else
                                If tab_bd(i, 3) <> "" Then
                                    TextBox1.Value = TextBox1.Value & " ***** " & " - " & tab_bd(i, 0) & " (" & tab_bd(i, 1) & " )" & " " & tab_bd(i, 3)
                                Else
                                    TextBox1.Value = TextBox1.Value & " ***** " & " - " & tab_bd(i, 0) & " (" & tab_bd(i, 1) & " )"
                                End If
                            End If
                            If Cells(Jour + 2, colonne + 1).Comment Is Nothing And tab_bd(i, 3) <> "" Then 'ajouter infobulle Note dans la colonne du milieu
                                Cells(Jour + 2, colonne + 1).AddComment
                                Cells(Jour + 2, colonne + 1).Comment.Text Text:=tab_bd(i, 3)
                                With Cells(Jour + 2, colonne + 1).Comment.Shape
                                    .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 12: .OLEFormat.Object.Interior.ColorIndex = 34: .TextFrame.Characters.Font.ColorIndex = 11: .TextFrame.Characters.Font.Bold = True: .OLEFormat.Object.Font.Name = "Calibri": .AutoShapeType = msoShapeRoundedRectangle
                                 End With
                            Else
                                If tab_bd(i, 3) <> "" Then
                                Cells(Jour + 2, colonne + 1).Comment.Text Text:=tab_bd(i, 3)
                                With Cells(Jour + 2, colonne + 1).Comment.Shape
                                    .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 12: .OLEFormat.Object.Interior.ColorIndex = 34: .TextFrame.Characters.Font.ColorIndex = 11: .TextFrame.Characters.Font.Bold = True: .OLEFormat.Object.Font.Name = "Calibri": .AutoShapeType = msoShapeRoundedRectangle
                                 End With
                                 End If
                            End If

                        no_couleur = tab_bd(i, 2)
                        If Val(Application.Version) < 12 Then 'Si Excel < 2007
                            If no_couleur = 0 Then
                                Cells(Jour + 2, colonne + 1).Interior.ColorIndex = 43
                            ElseIf no_couleur = 1 Then
                                Cells(Jour + 2, colonne + 1).Interior.ColorIndex = 37
                            ElseIf no_couleur = 2 Then
                                Cells(Jour + 2, colonne + 1).Interior.ColorIndex = 38
                            ElseIf no_couleur = 3 Then
                                Cells(Jour + 2, colonne + 1).Interior.ColorIndex = 44
                            ElseIf no_couleur = 4 Then
                                Cells(Jour + 2, colonne + 1).Interior.ColorIndex = 45
                            ElseIf no_couleur = 5 Then
                                Cells(Jour + 2, colonne + 1).Interior.ColorIndex = 15
                            End If
                        Else
                            If no_couleur = 0 Then
                                Cells(Jour + 2, colonne + 1).Interior.color = RGB(166, 219, 111)
                            ElseIf no_couleur = 1 Then
                                Cells(Jour + 2, colonne + 1).Interior.color = RGB(101, 183, 219)
                            ElseIf no_couleur = 2 Then
                                Cells(Jour + 2, colonne + 1).Interior.color = RGB(219, 125, 111)
                            ElseIf no_couleur = 3 Then
                                Cells(Jour + 2, colonne + 1).Interior.color = RGB(229, 223, 78)
                            ElseIf no_couleur = 4 Then
                                Cells(Jour + 2, colonne + 1).Interior.color = RGB(233, 196, 59)
                            ElseIf no_couleur = 5 Then
                                Cells(Jour + 2, colonne + 1).Interior.color = RGB(190, 190, 190)
                            End If
                        End If
                        Exit For
                    End If
                Next 'fin gestion des données de BD_CAL
            End If

            If (Cells(Jour + 2, colonne + 2).Value = "FH") Then ' affectation de la valeur de la ligne ESAT de la feuille Stats repas FH à la variable MyValeur
                Myvaleur = ThisWorkbook.Worksheets("Stats repas").Cells(num_ligne - 1, col1).Value
            Else
                Myvaleur = Cells(Jour + 2, colonne + 2).Value
            End If
            Select Case Myvaleur 'affectation de couleur de fond et de couleur de police selon planning ESAT
                Case 2: Cells(Jour + 2, colonne + 2).Interior.color = RGB(0, 128, 0): Cells(Jour + 2, colonne + 2).Font.color = RGB(0, 128, 0)
                Case 1: Cells(Jour + 2, colonne + 2).Interior.color = RGB(255, 165, 0): Cells(Jour + 2, colonne + 2).Font.color = RGB(255, 165, 0)
                Case 3 To 4: Cells(Jour + 2, colonne + 2).Interior.color = RGB(0, 191, 255): Cells(Jour + 2, colonne + 2).Font.color = RGB(0, 191, 255)
                Case 5: Cells(Jour + 2, colonne + 2).Interior.color = RGB(216, 191, 216): Cells(Jour + 2, colonne + 2).Font.color = RGB(216, 191, 216)
                Case 6: Cells(Jour + 2, colonne + 2).Interior.color = RGB(255, 0, 0): Cells(Jour + 2, colonne + 2).Font.color = RGB(255, 0, 0)
                Case 7: Cells(Jour + 2, colonne + 2).Interior.color = RGB(176, 196, 222): Cells(Jour + 2, colonne + 2).Font.color = RGB(176, 196, 222)
                Case 9: Cells(Jour + 2, colonne + 2).Interior.color = RGB(128, 0, 128): Cells(Jour + 2, colonne + 2).Font.color = RGB(128, 0, 128)
                Case 0: Cells(Jour + 2, colonne + 2).Font.color = RGB(255, 255, 255):
            End Select
            If (Cells(Jour + 2, colonne + 2).Value = "FH") Then
                Cells(Jour + 2, colonne + 2).Font.color = RGB(186, 74, 0)
            End If
            If nom1 = "Melanie" Or nom1 = "Kelvine" Or nom1 = "Frederique" Then 'Si foyer de vie
                Cells(Jour + 2, colonne + 2).Interior.ColorIndex = xlColorIndexNone
            End If
        Next 'Fin des jours
    nb1 = nb1 + 1 'incrementation de nb1 pour calcul de la colonne du mois suivant
    Next

    For ligne = 1 To 18 'Saisie de infos generales du résident
        If Sheets("InfosGen").Cells(ligne, 1) = nom1 Then
            If TextBox2.Value = "" Then
                TextBox2.Value = Sheets("InfosGen").Cells(ligne, 2)
            Else
                TextBox2.Value = TextBox2.Value & Chr(10) & Sheets("InfosGen").Cells(ligne, 2)
            End If
        End If
    Next

    'enlever bordure du 29 fevrier et mettre fond gris
    Range("E31:F31").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous: .ColorIndex = 0: .TintAndShade = 0: .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .Pattern = xlSolid: .PatternColorIndex = xlAutomatic: .ThemeColor = xlThemeColorDark1: .TintAndShade = -4.99893185216834E-02: .PatternTintAndShade = 0
    End With
Application.ScreenUpdating = BoEcran: Application.DisplayStatusBar = BoBarre: Application.Calculation = iCalcul: Application.EnableEvents = BoEvent: ActiveSheet.DisplayPageBreaks = BoSaut
End Sub

Private Sub CommandButton1_Click() 'Modifier commentaires de base du résident
    Dim i As Integer: Dim nom1 As String
    nom1 = ComboBox1.Value
    For i = 1 To 18
        If Sheets("InfosGen").Cells(i, 1) = nom1 Then
            Sheets("InfosGen").Cells(i, 2) = TextBox2.Value
            Exit For
        End If
    Next i
End Sub

Private Sub CommandButton2_Click() 'appel MENU
 With UserMenu
    .StartUpPosition = 0: .Left = 10: .Top = 0: .Show 0
End With
End Sub

Private Sub CommandButton3_Click() 'Selection pour impression
 Range("a1:aj50").Select
End Sub

Private Sub Worksheet_Activate() 'insérer dans la liste déroulante le prénom des résidents => ap4:ap21
    ComboBox1.List() = Range("ap4:ap21").Value

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Interior.color <> Range("A1").Interior.color And Target.Interior.color <> Range("A2").Interior.color Then
    'si couleur de fond de la cellule double cliquée est différente de la couleur de a1 et a2 alors la cellule fait partie du tableau
        Cancel = True
        If (Target.Column = 1 Or Target.Column = 4 Or Target.Column = 7 Or Target.Column = 10 Or Target.Column = 13 Or Target.Column = 16 Or Target.Column = 19 Or Target.Column = 22 Or Target.Column = 25 Or Target.Column = 28 Or Target.Column = 31 Or Target.Column = 34) Then
            Target.Offset(0, 1).Select ' si la cellule est = à la première colonne du mois, alors selection de la cellule à droite soit celle du milieu
        End If
        If (Target.Column = 2 Or Target.Column = 5 Or Target.Column = 8 Or Target.Column = 11 Or Target.Column = 14 Or Target.Column = 17 Or Target.Column = 20 Or Target.Column = 23 Or Target.Column = 26 Or Target.Column = 29 Or Target.Column = 32 Or Target.Column = 35) Then
            Target.Offset(0, 0).Select ' si la cellule est = à deuxième colonne du mois, alors selection de cette cellule soit celle du milieu
        End If
        If (Target.Column = 3 Or Target.Column = 6 Or Target.Column = 9 Or Target.Column = 12 Or Target.Column = 15 Or Target.Column = 18 Or Target.Column = 21 Or Target.Column = 24 Or Target.Column = 27 Or Target.Column = 30 Or Target.Column = 33 Or Target.Column = 36) Then
            Target.Offset(0, -1).Select ' si la cellule est = à la troisième colonne du mois, alors selection de la cellule à gauche soit celle du milieu
        End If
            Load UserForm_notes 'ouverture Userform_notes
            UserForm_notes.Label_date.Caption = ActiveCell.Offset(0, -1) 'affectation de la date de la 1ère colonne a Label_Date du userform_notes
            UserForm_notes.Show
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'au changement de selection garder la feuille Calendrie activée
    If ActiveSheet.Name <> "Calendrier" Then
        ActiveSheet.Name = "Calendrier"
    End If
End Sub

et le code de l'userform

Private Sub UserForm_initialize()
    Dim couleurs(): Dim i As Integer: Dim nomP As String: Dim derniere_ligne As Integer: Dim date_selectionnee As Date: Dim ligne As Integer: Dim num_ligneP As Integer: Dim colFH As Integer: Dim test1 As Integer
    c1.BackColor = RGB(166, 219, 111): Label6.BackColor = RGB(166, 219, 111): c2.BackColor = RGB(101, 183, 219): Label7.BackColor = RGB(101, 183, 219)
    c3.BackColor = RGB(219, 125, 111): Label9.BackColor = RGB(219, 125, 111): c4.BackColor = RGB(229, 223, 78): Label11.BackColor = RGB(229, 223, 78)
    c5.BackColor = RGB(233, 196, 59): Label13.BackColor = RGB(233, 196, 59): c6.BackColor = RGB(190, 190, 190): Label15.BackColor = RGB(190, 190, 190)
    Sheets("Calendrier").TextBox1.Value = "": Resident.Caption = Range("a1").Value: couleurs = Array("Rf", "Rm", "Rp", "CG", "Div", "URG"): nomP = Range("a1").Value
    ComboBox_couleurs.Clear
    Label22.ZOrder msoSendToBack: Label24.ZOrder msoSendToBack
    For i = 0 To UBound(couleurs)
        ComboBox_couleurs.AddItem couleurs(i)
    Next
    LabelD1.Caption = Format(ActiveCell.Offset(0, -1), "ddd dd mmm yyyy")
   ComboBoxLM.AddItem "C": ComboBoxLM.AddItem "S": ComboBoxLM.AddItem "CAF": ComboBoxLM.AddItem "HF"
   ComboBoxLM.AddItem "KFK": ComboBoxLM.AddItem "CD": ComboBoxLM.AddItem "CI": ComboBoxLM.AddItem "": ComboBoxLM.AddItem "0": ComboBoxLM.AddItem "1"
   ComboBoxLS.AddItem "C": ComboBoxLS.AddItem "S": ComboBoxLS.AddItem "CAF": ComboBoxLS.AddItem "HF"
   ComboBoxLS.AddItem "KFK": ComboBoxLS.AddItem "CD": ComboBoxLS.AddItem "CI": ComboBoxLS.AddItem "": ComboBoxLS.AddItem "0": ComboBoxLS.AddItem "1"
   ComboBoxPL.AddItem "x": ComboBoxPL.AddItem "x<": ComboBoxPL.AddItem ">": ComboBoxPL.AddItem "":

   ComboBoxMidi.AddItem "C": ComboBoxMidi.AddItem "S": ComboBoxMidi.AddItem "CAF": ComboBoxMidi.AddItem "HF"
   ComboBoxMidi.AddItem "KFK": ComboBoxMidi.AddItem "CD": ComboBoxMidi.AddItem "CI": ComboBoxMidi.AddItem "": ComboBoxMidi.AddItem "0": ComboBoxMidi.AddItem "1"
   ComboBoxSoir.AddItem "C": ComboBoxSoir.AddItem "S": ComboBoxSoir.AddItem "CAF": ComboBoxSoir.AddItem "HF"
   ComboBoxSoir.AddItem "KFK": ComboBoxSoir.AddItem "CD": ComboBoxSoir.AddItem "CI": ComboBoxSoir.AddItem "": ComboBoxSoir.AddItem "0": ComboBoxSoir.AddItem "1"
    'Remplissage
    derniere_ligne = Sheets("BD_CAL").Range("A65000").End(xlUp).Row
    date_selectionnee = ActiveCell.Offset(0, -1)

    For ligne = 2 To derniere_ligne
        If Sheets("BD_CAL").Cells(ligne, 5) = Resident.Caption Then
            If Sheets("Calendrier").TextBox1.Value = "" Then
                Sheets("Calendrier").TextBox1.Value = " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            Else
                Sheets("Calendrier").TextBox1.Value = Sheets("Calendrier").TextBox1.Value & Chr(10) & " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            End If
        End If
        If Sheets("BD_CAL").Cells(ligne, 1) = date_selectionnee And Sheets("BD_CAL").Cells(ligne, 5) = Resident.Caption Then

            TextBox_initiales.Value = Sheets("BD_CAL").Cells(ligne, 2)
            ComboBox_couleurs.ListIndex = Sheets("BD_CAL").Cells(ligne, 3)
            TextBox_notes.Value = Sheets("BD_CAL").Cells(ligne, 4)
            Resident.Caption = Sheets("BD_CAL").Cells(ligne, 5)
            Label_ligne.Caption = ligne
            If Sheets("Calendrier").TextBox1.Value = "" Then
                Sheets("Calendrier").TextBox1.Value = " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            Else
                Sheets("Calendrier").TextBox1.Value = Sheets("Calendrier").TextBox1.Value & Chr(10) & " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            End If
            CommandButton_annuler.Left = 18
            Exit For
        End If
    Next

    Select Case nomP
        Case "Daniel": num_ligneP = 58
        Case "Thibaut": num_ligneP = 67
        Case "Caroline": num_ligneP = 76
        Case "Arnaud": num_ligneP = 85
        Case "Deborah": num_ligneP = 94
        Case "Marjorie": num_ligneP = 103
        Case "Theo": num_ligneP = 112
        Case "Thalia": num_ligneP = 121
        Case "Andrew": num_ligneP = 130
        Case "Aude": num_ligneP = 139
        Case "Quentin": num_ligneP = 148
        Case "Amandine": num_ligneP = 157
        Case "Selim": num_ligneP = 166
        Case "Wilfried": num_ligneP = 175
        Case "Krystopher": num_ligneP = 184
        Case "Kelvine": num_ligneP = 191
        Case "Melanie": num_ligneP = 198
        Case "Frederique": num_ligneP = 205
   End Select
   If nomP = "Caroline" Then
        ComboBoxPL.Visible = True: ComboBoxLM.Visible = True: ComboBoxLS.Visible = True: LL.Visible = True: L1.Visible = True
   Else
        ComboBoxPL.Visible = False: ComboBoxLM.Visible = False: ComboBoxLS.Visible = False: LL.Visible = False: L1.Visible = False
   End If
    'affichage présences FH et repas
    For colFH = 5 To 382
        If Sheets("Stats repas").Cells(55, colFH) = date_selectionnee Then
            ComboBoxPres.Value = Sheets("Stats repas").Cells(num_ligneP, colFH).Value
            ComboBoxMidi.Value = Sheets("Stats repas").Cells(num_ligneP + 4, colFH).Value
            ComboBoxSoir.Value = Sheets("Stats repas").Cells(num_ligneP + 5, colFH).Value
            Lp.Caption = Sheets("Stats repas").Cells(num_ligneP + 1, colFH).Value & "-" & Sheets("Stats repas").Cells(num_ligneP + 2, colFH).Value & "-" & Sheets("Stats repas").Cells(num_ligneP + 3, colFH).Value
            If nomP = "Caroline" Then
                LL.Caption = Sheets("Stats repas").Cells(231, colFH).Value & "-" & Sheets("Stats repas").Cells(232, colFH).Value & "-" & Sheets("Stats repas").Cells(233, colFH).Value
                ComboBoxPL.Value = Sheets("Stats repas").Cells(236, colFH).Value
                ComboBoxLM.Value = Sheets("Stats repas").Cells(234, colFH).Value
                ComboBoxLS.Value = Sheets("Stats repas").Cells(235, colFH).Value
            End If
            If nomP <> "Frederique" Then
                test1 = Sheets("Stats repas").Cells(num_ligneP - 2, colFH).Value
            Else
                test1 = 0
            End If
            Exit For
        End If
    Next

    If test1 = 1 Or test1 = 2 Then
        ComboBoxPres.AddItem "<": ComboBoxPres.AddItem ">": ComboBoxPres.AddItem ""
    Else
        ComboBoxPres.AddItem "x": ComboBoxPres.AddItem "x>": ComboBoxPres.AddItem "x<": ComboBoxPres.AddItem "<": ComboBoxPres.AddItem ">": ComboBoxPres.AddItem "":
    End If
End Sub

Private Sub CommandButton_annuler_Click()
    Unload Me
End Sub

Private Sub ComboBox_couleurs_Change() 'couleur de fond de la liste déroulante des motifs
    Dim no_couleur As Integer
    no_couleur = ComboBox_couleurs.ListIndex
    If no_couleur = 0 Then
        ComboBox_couleurs.BackColor = RGB(166, 219, 111)
    ElseIf no_couleur = 1 Then
        ComboBox_couleurs.BackColor = RGB(101, 183, 219)
    ElseIf no_couleur = 2 Then
        ComboBox_couleurs.BackColor = RGB(219, 125, 111)
    ElseIf no_couleur = 3 Then
        ComboBox_couleurs.BackColor = RGB(229, 223, 78)
    ElseIf no_couleur = 4 Then
        ComboBox_couleurs.BackColor = RGB(233, 196, 59)
    ElseIf no_couleur = 5 Then
        ComboBox_couleurs.BackColor = RGB(190, 190, 190)
    Else
        ComboBox_couleurs.BackColor = &HFFFFFF
    End If
    If no_couleur >= 0 Then TextBox_notes.SetFocus
End Sub

Private Sub ComboBoxMidi_Change() 'Au changement du repas de midi
    Dim Datep As Date: Dim nomP As String: Dim num_ligneP As Integer: Dim plage2P As Range: Dim cell As Variant: Dim col1 As Integer: Dim col As String
    Datep = ActiveCell.Offset(0, -1): nomP = Range("a1").Value
    ActiveCell.Offset(0, 1).ClearComments
    Select Case nomP
        Case "Daniel": num_ligneP = 58
        Case "Thibaut": num_ligneP = 67
        Case "Caroline": num_ligneP = 76
        Case "Arnaud": num_ligneP = 85
        Case "Deborah": num_ligneP = 94
        Case "Marjorie": num_ligneP = 103
        Case "Theo": num_ligneP = 112
        Case "Thalia": num_ligneP = 121
        Case "Andrew": num_ligneP = 130
        Case "Aude": num_ligneP = 139
        Case "Quentin": num_ligneP = 148
        Case "Amandine": num_ligneP = 157
        Case "Selim": num_ligneP = 166
        Case "Wilfried": num_ligneP = 175
        Case "Krystopher": num_ligneP = 184
        Case "Kelvine": num_ligneP = 191
        Case "Melanie": num_ligneP = 198
        Case "Frederique": num_ligneP = 205
    End Select
    Set plage2P = ThisWorkbook.Worksheets("Stats repas").Range("e55:nr55")
    For Each cell In plage2P
        If cell.Value = CDate(Datep) Then
            col1 = cell.Column: col = Mid(cell.Address, 2, InStr(2, cell.Address, "$") - 2)
        End If
    Next cell
    With ThisWorkbook.Worksheets("Stats repas") 'Affectation de la valeur de midi de la liste déroulante dans la feuille Stats repas
        .Cells(num_ligneP + 4, col1).Value = ComboBoxMidi.Value
        .Cells(num_ligneP - 2, col1).ClearComments
        If ComboBoxMidi.Value <> "" Or ComboBoxSoir.Value <> "" Then
            If num_ligneP < 190 Then
                With .Cells(num_ligneP - 2, col1)
                    .AddComment: .Comment.Visible = True: .Comment.Text Text:=LCase(ComboBoxMidi.Value) & "-" & UCase(ComboBoxSoir.Value)
                    With .Comment.Shape
                        .TextFrame.AutoSize = True
                        .AutoShapeType = msoShapeRoundedRectangle
                    End With
                End With
            End If
        End If
    End With

' Mis à jour du label Lp (0,0,1)
Lp.Caption = ComboBoxMidi.Value & "-" & Sheets("Stats repas").Cells(num_ligneP + 2, col1).Value & "-" & Sheets("Stats repas").Cells(num_ligneP + 3, col1).Value
Call essai1 'Appel de la procédure essai1 pour mettre à jour le planning
End Sub

Private Sub ComboBoxSoir_Change() ' Au changement du repas du soir
    Dim Datep As Date: Dim nomP As String: Dim num_ligneP As Integer: Dim plage2P As Range: Dim cell As Variant: Dim col1 As Integer: Dim col As String
    Datep = ActiveCell.Offset(0, -1): nomP = Range("a1").Value
    ActiveCell.Offset(0, 1).ClearComments

    Select Case nomP
        Case "Daniel": num_ligneP = 58
        Case "Thibaut": num_ligneP = 67
        Case "Caroline": num_ligneP = 76
        Case "Arnaud": num_ligneP = 85
        Case "Deborah": num_ligneP = 94
        Case "Marjorie": num_ligneP = 103
        Case "Theo": num_ligneP = 112
        Case "Thalia": num_ligneP = 121
        Case "Andrew": num_ligneP = 130
        Case "Aude": num_ligneP = 139
        Case "Quentin": num_ligneP = 148
        Case "Amandine": num_ligneP = 157
        Case "Selim": num_ligneP = 166
        Case "Wilfried": num_ligneP = 175
        Case "Krystopher": num_ligneP = 184
        Case "Kelvine": num_ligneP = 191
        Case "Melanie": num_ligneP = 198
        Case "Frederique": num_ligneP = 205
    End Select

    Set plage2P = ThisWorkbook.Worksheets("Stats repas").Range("e55:nr55")
    For Each cell In plage2P
        If cell.Value = CDate(Datep) Then
            col1 = cell.Column: col = Mid(cell.Address, 2, InStr(2, cell.Address, "$") - 2)
        End If
    Next cell
    With ThisWorkbook.Worksheets("Stats repas") 'Affectation de la valeur de midi de la liste déroulante dans la feuille Stats repas
        .Cells(num_ligneP + 5, col1).Value = ComboBoxSoir.Value
        .Cells(num_ligneP - 2, col1).ClearComments
        If ComboBoxMidi.Value <> "" Or ComboBoxSoir.Value <> "" Then
            If num_ligneP < 190 Then
                With .Cells(num_ligneP - 2, col1)
                    .AddComment: .Comment.Visible = True: .Comment.Text Text:=LCase(ComboBoxMidi.Value) & "-" & UCase(ComboBoxSoir.Value)
                    With .Comment.Shape
                        .TextFrame.AutoSize = True
                        .AutoShapeType = msoShapeRoundedRectangle
                    End With
                End With
            End If
        End If
    End With
    Lp.Caption = Sheets("Stats repas").Cells(num_ligneP + 1, col1).Value & "-" & Sheets("Stats repas").Cells(num_ligneP + 2, col1).Value & "-" & Sheets("Stats repas").Cells(num_ligneP + 3, col1).Value
    Call essai1
End Sub

Private Sub ComboBoxPres_Change()
    Dim Datep As Date: Dim num_ligneP As Integer: Dim nomP As String: Dim cell As Variant: Dim col1 As Integer: Dim bilan As String: Dim bilan2 As String: Dim plage2P As Range: Dim col As String
    Datep = ActiveCell.Offset(0, -1): nomP = Range("a1").Value
    Select Case nomP 'numéro de ligne selon résident
        Case "Daniel": num_ligneP = 58
        Case "Thibaut": num_ligneP = 67
        Case "Caroline": num_ligneP = 76
        Case "Arnaud": num_ligneP = 85
        Case "Deborah": num_ligneP = 94
        Case "Marjorie": num_ligneP = 103
        Case "Theo": num_ligneP = 112
        Case "Thalia": num_ligneP = 121
        Case "Andrew": num_ligneP = 130
        Case "Aude": num_ligneP = 139
        Case "Quentin": num_ligneP = 148
        Case "Amandine": num_ligneP = 157
        Case "Selim": num_ligneP = 166
        Case "Wilfried": num_ligneP = 175
        Case "Krystopher": num_ligneP = 184
        Case "Kelvine": num_ligneP = 191
        Case "Melanie": num_ligneP = 198
        Case "Frederique": num_ligneP = 205
    End Select
    ThisWorkbook.Worksheets("Stats repas").Activate 'recherche colonne dans Stats repas
    Set plage2P = ThisWorkbook.Worksheets("Stats repas").Range("e55:nr55")
    For Each cell In plage2P
        If cell.Value = CDate(Datep) Then
            col1 = cell.Column: col = Mid(cell.Address, 2, InStr(2, cell.Address, "$") - 2)
        End If
    Next cell

    With ThisWorkbook.Worksheets("Stats repas") 'maj de la valeur
        bilan = ComboBoxPres.Value: .Cells(num_ligneP, col1).Value = ComboBoxPres.Value
    End With

    If bilan = "x>" Or bilan = "x<" Or bilan = "x" Then
        bilan2 = "FH"
    Else
        bilan2 = ""
    End If
    ThisWorkbook.Worksheets("Calendrier").Activate 'saisie ou non de FH dans la cellule active de la feuille Calendrier
    ActiveCell.Offset(0, 1).Value = bilan2: ActiveCell.Offset(0, 1).Font.color = RGB(186, 74, 0)
    Call essai1

End Sub

Private Sub ComboBoxPL_Change()
    Dim Datep As Date: Dim cell As Variant: Dim col1 As Integer: Dim plage2P As Range: Dim col As String
    Datep = ActiveCell.Offset(0, -1)

    ThisWorkbook.Worksheets("Stats repas").Activate 'recherche colonne dans Stats repas
    Set plage2P = ThisWorkbook.Worksheets("Stats repas").Range("e55:nr55")
    For Each cell In plage2P
        If cell.Value = CDate(Datep) Then
            col1 = cell.Column: col = Mid(cell.Address, 2, InStr(2, cell.Address, "$") - 2)
        End If
    Next cell

    With ThisWorkbook.Worksheets("Stats repas") 'maj de la valeur
        .Cells(236, col1).Value = ComboBoxPL.Value
    End With
    ThisWorkbook.Worksheets("Calendrier").Activate 'saisie ou non de FH dans la cellule active de la feuille Calendrier
    Call essai1
End Sub

Private Sub CommandButton_enreg_Click() 'Enregistrer la note
    Dim dd As String: Dim ligne_insertion As Integer: Dim derniere_ligne As Integer: Dim ligne As Integer: Dim num_ligneS As Integer
    Dim DateS As Date: Dim cell As Variant: Dim colS As Integer: Dim plage2S As Range
    DateS = ActiveCell.Offset(0, -1)

    Select Case Resident.Caption 'numéro de ligne selon résident
        Case "Daniel": num_ligneS = 58
        Case "Thibaut": num_ligneS = 67
        Case "Caroline": num_ligneS = 76
        Case "Arnaud": num_ligneS = 85
        Case "Deborah": num_ligneS = 94
        Case "Marjorie": num_ligneS = 103
        Case "Theo": num_ligneS = 112
        Case "Thalia": num_ligneS = 121
        Case "Andrew": num_ligneS = 130
        Case "Aude": num_ligneS = 139
        Case "Quentin": num_ligneS = 148
        Case "Amandine": num_ligneS = 157
        Case "Selim": num_ligneS = 166
        Case "Wilfried": num_ligneS = 175
        Case "Krystopher": num_ligneS = 184
        Case "Kelvine": num_ligneS = 191
        Case "Melanie": num_ligneS = 198
        Case "Frederique": num_ligneS = 205
    End Select
    If num_ligneS > 190 Then
        num_ligneS = num_ligneS + 1
    End If
    If ComboBox_couleurs.ListIndex = -1 Then 'Vérifier si un motif dans la liste déroulante a été sélectionné
        dd = MsgBox("Merci de renseigner au moins les initiales du motif" & Chr(10) & Chr(10) & "PAS BESOIN D'ENREGISTRER POUR PRENDRE EN COMPTE LES CHANGEMENTS DE PRESENCES FH ET REPAS", 48, "Erreur")
    Else 'Si OK
        'Verifie si il y a 1 note ce jour pour ce résident, si caption de label_ligne est LIGNE alors pas de note
        'Alors ligne_insertion = dernière ligne +1 du tableau dans la feuille BD_CAL
        If Label_ligne.Caption = "LIGNE" Then
            ligne_insertion = Sheets("BD_CAL").Range("A65000").End(xlUp).Row + 1
        Else 'Si 1 note existe alors on recupère le numéro de ligne saisi dans le label label_ligne
            ligne_insertion = Label_ligne.Caption
        End If
        Sheets("BD_CAL").Cells(ligne_insertion, 1) = CDate(Label_date.Caption) 'Ajouter dans le tableau de la feuille BD_CAL...
        Sheets("BD_CAL").Cells(ligne_insertion, 2) = ComboBox_couleurs.Value   ' les valeurs saisies dans userform
        Sheets("BD_CAL").Cells(ligne_insertion, 3) = ComboBox_couleurs.ListIndex
        Sheets("BD_CAL").Cells(ligne_insertion, 4) = TextBox_notes.Value
        Sheets("BD_CAL").Cells(ligne_insertion, 5) = Resident.Caption

        ActiveCell = ComboBox_couleurs.Value 'Ajouter initiale du motif de la note dans la cellule active de la feuille Calendrier
        If ActiveCell.Comment Is Nothing And TextBox_notes.Value <> "" Then
            ActiveCell.AddComment: ActiveCell.Comment.Text Text:=TextBox_notes.Value
            With ActiveCell.Comment.Shape
                .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 12: .OLEFormat.Object.Interior.ColorIndex = 34: .TextFrame.Characters.Font.ColorIndex = 11: .TextFrame.Characters.Font.Bold = True: .OLEFormat.Object.Font.Name = "Calibri": .AutoShapeType = msoShapeRoundedRectangle
             End With
        Else
            If TextBox_notes.Value <> "" Then
            ActiveCell.Comment.Text Text:=TextBox_notes.Value
            With ActiveCell.Comment.Shape
                .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 12: .OLEFormat.Object.Interior.ColorIndex = 34: .TextFrame.Characters.Font.ColorIndex = 11: .TextFrame.Characters.Font.Bold = True: .OLEFormat.Object.Font.Name = "Calibri": .AutoShapeType = msoShapeRoundedRectangle
             End With
             End If
        End If

    ThisWorkbook.Worksheets("Stats repas").Activate 'recherche colonne dans Stats repas
    Set plage2S = ThisWorkbook.Worksheets("Stats repas").Range("e55:nr55")
    For Each cell In plage2S
        If cell.Value = CDate(DateS) Then
            colS = cell.Column
        End If
    Next cell
    With ThisWorkbook.Worksheets("Stats repas") 'maj de la valeur
        If .Cells(num_ligneS - 1, colS).Comment Is Nothing Then
            .Cells(num_ligneS - 1, colS).AddComment: .Cells(num_ligneS - 1, colS).Comment.Text Text:=ComboBox_couleurs.Value & " : " & TextBox_notes.Value
            .Cells(num_ligneS - 1, colS).Comment.Visible = True
            With .Cells(num_ligneS - 1, colS).Comment.Shape
                .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 10: .OLEFormat.Object.Interior.ColorIndex = 34: .TextFrame.Characters.Font.ColorIndex = 11: .OLEFormat.Object.Font.Name = "Abadi": .AutoShapeType = msoShapeRoundedRectangle
                .Fill.Transparency = 0.45
             End With
        Else
            .Cells(num_ligneS - 1, colS).Comment.Text Text:=ComboBox_couleurs.Value & " : " & TextBox_notes.Value
            .Cells(num_ligneS - 1, colS).Comment.Visible = True
            .Cells(num_ligneS - 1, colS).Comment.Transparency = 0.5
            With .Cells(num_ligneS - 1, colS).Comment.Shape
                .TextFrame.AutoSize = True: .OLEFormat.Object.Font.Size = 10: .OLEFormat.Object.Interior.ColorIndex = 34: .TextFrame.Characters.Font.ColorIndex = 11: .OLEFormat.Object.Font.Name = "Abadi": .AutoShapeType = msoShapeRoundedRectangle
                .Fill.Transparency = 0.45
             End With
        End If
    End With

    ThisWorkbook.Worksheets("Calendrier").Activate 'recherche colonne dans Stats repas
        If ComboBox_couleurs.ListIndex >= 0 Then 'Affectation interor.color à la cellule active du motif de la note choisie
            ActiveCell.Interior.color = ComboBox_couleurs.BackColor
        Else
            ActiveCell.Interior.color = ActiveCell.Offset(0, -1).Interior.color
        End If
    Unload Me
    End If
        'Actualiser notes dans la feuille Calendrier
    Sheets("Calendrier").TextBox1.Value = "":
    derniere_ligne = Sheets("BD_CAL").Range("A65000").End(xlUp).Row
    For ligne = 2 To derniere_ligne 'mis à jour de lka liste des notes du résident dans la textbox1 de la feuille Calendrier
        If Sheets("BD_CAL").Cells(ligne, 5) = Resident.Caption Then
            If Sheets("Calendrier").TextBox1.Value = "" Then
                Sheets("Calendrier").TextBox1.Value = " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            Else
                Sheets("Calendrier").TextBox1.Value = Sheets("Calendrier").TextBox1.Value & Chr(10) & " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            End If
        End If
    Next
End Sub

Private Sub CommandButton_suppr_Click() 'suppression note
    Dim ligne_insertion As Integer: Dim num_ligneS As Integer
    Dim DateS As Date: Dim cell As Variant: Dim colS As Integer: Dim plage2S As Range
    DateS = ActiveCell.Offset(0, -1)

    Select Case Resident.Caption 'numéro de ligne selon résident
        Case "Daniel": num_ligneS = 58
        Case "Thibaut": num_ligneS = 67
        Case "Caroline": num_ligneS = 76
        Case "Arnaud": num_ligneS = 85
        Case "Deborah": num_ligneS = 94
        Case "Marjorie": num_ligneS = 103
        Case "Theo": num_ligneS = 112
        Case "Thalia": num_ligneS = 121
        Case "Andrew": num_ligneS = 130
        Case "Aude": num_ligneS = 139
        Case "Quentin": num_ligneS = 148
        Case "Amandine": num_ligneS = 157
        Case "Selim": num_ligneS = 166
        Case "Wilfried": num_ligneS = 175
        Case "Krystopher": num_ligneS = 184
        Case "Kelvine": num_ligneS = 191
        Case "Melanie": num_ligneS = 198
        Case "Frederique": num_ligneS = 205
    End Select
    If num_ligneS > 190 Then
        num_ligneS = num_ligneS + 1
    End If

    ligne_insertion = Label_ligne.Caption
    Sheets("BD_CAL").Range(ligne_insertion & ":" & ligne_insertion).Delete
   ActiveCell.Clear

    ThisWorkbook.Worksheets("Stats repas").Activate 'recherche colonne dans Stats repas
    Set plage2S = ThisWorkbook.Worksheets("Stats repas").Range("e55:nr55")
    For Each cell In plage2S
        If cell.Value = CDate(DateS) Then
            colS = cell.Column
        End If
    Next cell
    With ThisWorkbook.Worksheets("Stats repas") 'maj de la valeur
        .Cells(num_ligneS - 1, colS).ClearComments
    End With

    ThisWorkbook.Worksheets("Calendrier").Activate 'recherche colonne dans Stats repas
    'Actualiser notes
        UserForm_initialize
    Unload Me
End Sub

Sub essai1()
    Dim couleurs(): Dim ligne As Integer: Dim nomP As String: Dim derniere_ligne As Integer: Dim date_selectionnee As Date: Dim num_ligneP As Integer: Dim colFH As Integer: Dim commrepas As String
    Sheets("Calendrier").Activate
    c1.BackColor = RGB(166, 219, 111): c2.BackColor = RGB(101, 183, 219): c3.BackColor = RGB(219, 125, 111): c4.BackColor = RGB(229, 223, 78): c5.BackColor = RGB(233, 196, 59): c6.BackColor = RGB(190, 190, 190)
    Sheets("Calendrier").TextBox1.Value = "": Resident.Caption = Range("a1").Value: Sheets("Calendrier").Range("g36") = "": couleurs = Array("Rf", "Rm", "Rp", "CG", "Div", "URG")
    nomP = Range("a1").Value: derniere_ligne = Sheets("BD_CAL").Range("A65000").End(xlUp).Row: date_selectionnee = ActiveCell.Offset(0, -1)
    Sheets("Calendrier").Activate
    For ligne = 2 To derniere_ligne 'Remplissage
        If Sheets("BD_CAL").Cells(ligne, 5) = Resident.Caption Then
            If Sheets("Calendrier").TextBox1.Value = "" Then
                Sheets("Calendrier").TextBox1.Value = " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            Else
                Sheets("Calendrier").TextBox1.Value = Sheets("Calendrier").TextBox1.Value & Chr(10) & " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            End If
        End If

        If Sheets("BD_CAL").Cells(ligne, 1) = date_selectionnee And Sheets("BD_CAL").Cells(ligne, 5) = Resident.Caption Then
            TextBox_initiales.Value = Sheets("BD_CAL").Cells(ligne, 2)
            ComboBox_couleurs.ListIndex = Sheets("BD_CAL").Cells(ligne, 3)
            TextBox_notes.Value = Sheets("BD_CAL").Cells(ligne, 4)
            Resident.Caption = Sheets("BD_CAL").Cells(ligne, 5)
            Label_ligne.Caption = ligne
            If Sheets("Calendrier").TextBox1.Value = "" Then
                Sheets("Calendrier").TextBox1.Value = " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            Else
                Sheets("Calendrier").TextBox1.Value = Sheets("Calendrier").TextBox1.Value & Chr(10) & " - " & Sheets("BD_CAL").Cells(ligne, 1) & " (" & Sheets("BD_CAL").Cells(ligne, 2) & ") " & Sheets("BD_CAL").Cells(ligne, 4)
            End If
            CommandButton_annuler.Left = 18
            Exit For
        End If
    Next

    Select Case nomP
        Case "Daniel": num_ligneP = 58
        Case "Thibaut": num_ligneP = 67
        Case "Caroline": num_ligneP = 76
        Case "Arnaud": num_ligneP = 85
        Case "Deborah": num_ligneP = 94
        Case "Marjorie": num_ligneP = 103
        Case "Theo": num_ligneP = 112
        Case "Thalia": num_ligneP = 121
        Case "Andrew": num_ligneP = 130
        Case "Aude": num_ligneP = 139
        Case "Quentin": num_ligneP = 148
        Case "Amandine": num_ligneP = 157
        Case "Selim": num_ligneP = 166
        Case "Wilfried": num_ligneP = 175
        Case "Krystopher": num_ligneP = 184
        Case "Kelvine": num_ligneP = 191
        Case "Melanie": num_ligneP = 198
        Case "Frederique": num_ligneP = 205
    End Select

    'affichage présences FH et repas
    For colFH = 5 To 382
        If Sheets("Stats repas").Cells(55, colFH) = date_selectionnee Then
            If nomP = "Caroline" Then
                ComboBoxPL.Value = Sheets("Stats repas").Cells(236, colFH).Value
                ComboBoxLM.Value = Sheets("Stats repas").Cells(234, colFH).Value
                ComboBoxLS.Value = Sheets("Stats repas").Cells(235, colFH).Value
                LL.Caption = Sheets("Stats repas").Cells(231, colFH).Value & "-" & Sheets("Stats repas").Cells(232, colFH).Value & "-" & Sheets("Stats repas").Cells(233, colFH).Value
            End If
            ComboBoxPres.Value = Sheets("Stats repas").Cells(num_ligneP, colFH).Value
            ComboBoxMidi.Value = Sheets("Stats repas").Cells(num_ligneP + 4, colFH).Value
            ComboBoxSoir.Value = Sheets("Stats repas").Cells(num_ligneP + 5, colFH).Value
            Lp.Caption = Sheets("Stats repas").Cells(num_ligneP + 1, colFH).Value & "-" & Sheets("Stats repas").Cells(num_ligneP + 2, colFH).Value & "-" & Sheets("Stats repas").Cells(num_ligneP + 3, colFH).Value
            If ThisWorkbook.Worksheets("Stats repas").Cells(num_ligneP + 4, colFH).Value <> "" Or ThisWorkbook.Worksheets("Stats repas").Cells(num_ligneP + 5, colFH).Value <> "" Then
                    commrepas = LCase(ThisWorkbook.Worksheets("Stats repas").Cells(num_ligneP + 4, colFH).Value) & "-" & UCase(ThisWorkbook.Worksheets("Stats repas").Cells(num_ligneP + 5, colFH).Value)
                    If ActiveCell.Offset(0, 1).Comment Is Nothing Then
                        ActiveCell.Offset(0, 1).AddComment
                        ActiveCell.Offset(0, 1).Comment.Text Text:=commrepas
                        With ActiveCell.Offset(0, 1).Comment.Shape
                                .TextFrame.AutoSize = True
                                .OLEFormat.Object.Font.Size = 6 'Taille du texte
                                .OLEFormat.Object.Interior.ColorIndex = 15 'Couleur de fond
                                .TextFrame.Characters.Font.ColorIndex = 54 'Couleur de la police
                                .TextFrame.Characters.Font.Bold = True 'Ecriture gras
                                .OLEFormat.Object.Font.Name = "Book Antiqua" 'Type de police
                         End With
                    Else
                        ActiveCell.Offset(0, 1).Comment.Text Text:=commrepas
                            With ActiveCell.Offset(0, 1).Comment.Shape
                                .TextFrame.AutoSize = True
                                .OLEFormat.Object.Font.Size = 6 'Taille du texte
                                .OLEFormat.Object.Interior.ColorIndex = 15 'Couleur de fond
                                .TextFrame.Characters.Font.ColorIndex = 54 'Couleur de la police
                                .TextFrame.Characters.Font.Bold = True 'Ecriture gras
                                .OLEFormat.Object.Font.Name = "Book Antiqua" 'Type de police
                             End With
                    End If
            End If
            Exit For
        End If
    Next
End Sub

Je vous remercie de votre aide

Cordialement

Le 12/01/2021 à 10:27

Bonjour,

Quand l'erreur est sur la ligne "Userform_notes Load" > cela signifie que le souci est dans Userform_Initialize ou Userform_Activate.

Clique sur la ligne commençant par " c1.BackColor " au début de Userform_Initialize ...

Puis > frappe F8 > à chaque frappe de F8 > le code va avancer d'une ligne > frappe doucement afin de trouver la ligne en défaut ...

ric

Le 13/01/2021 à 16:59

Merci pour votre aide

Depuis le temps que je code en vba, je ne savais pas utiliser le pas à pas

cela m'a permis de trouver l'endroit de l'erreur, de la comprendre et de la corriger.

je peux faire du pas à pas même quand il n'y a pas d'erreur ?

Je vous remercie beaucoup

Cordialement

Le 13/01/2021 à 17:06

Bonjour,

Le pas à pas peut être utilisé en tout temps et toutes saisons pour vérifier le format ou les valeurs des variables > etc. > etc. ...

Afin de passer un long bout de code qui va bien > la touche F9 marque une ligne > tu lances l'exécution de la macro normalement > elle va s'arrêter pile sur cette ligne > ensuite > tu continues avec F8 pour valider des besoins ...

ric

Rechercher des sujets similaires à "erreur lancement userform"