Créer un commentaire

Bonjour à toutes et tous

Je voudrais créer un commentaire dans une cellule avec le texte d'un autre cellule et selon une date. Je vous joins un fichier exemple pour plus de faciliter de compréhension.

Merci par avance à vous toutes et tous pour vos solutions

Bonjour,

une possibilité,

mais il reste à choisir l'événement qui exécutera la macro.

Sub Macro1()
Dim Message, Title, Default, LeChoix
Message = "Faite votre choix entre 1, 2 ou 3" & Chr(10) & Chr(10) & _
"1: Supprimer le commentaire" & Chr(10) & Chr(10) & _
"2: Remplacer le commentaire" & Chr(10) & Chr(10) & _
"3: Faire un ajout au commentaire" & Chr(10)

Title = "Démonstration de InputBox"
Default = "1"
LeChoix = InputBox(Message, Title, Default)

test = Application.Match(LeChoix, Array("1", "2", "3"), 0)
If LeChoix = "" Or IsError(test) Then Exit Sub

ligne = Application.Match(Cells(ActiveCell.Row, "A"), Sheets("2018").Range("B:B"), 0)
colonne = Application.Match(Cells(ActiveCell.Row, "C"), Sheets("2018").Range("1:1"), 0)

With Sheets("2018").Cells(ligne, colonne)
 Select Case LeChoix
  Case 1: .ClearComments

  Case 2: .ClearComments
          .AddComment
          .Comment.Text Sheets("Saisie des absences").Cells(ActiveCell.Row, "E").Value

  Case 3: .Comment.Text .Comment.Text & " " & Sheets("Saisie des absences").Cells(ActiveCell.Row, "E").Value
 End Select
End With
End Sub

Salut PE Victor, sabV,

une autre façon de faire...

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("E:E")) Is Nothing Then
    iRow = Target.Row
    If Cells(iRow, 1) <> "" Then
        With Worksheets("2018")
            iRow1 = .Range("B" & Rows.Count).End(xlUp).Row
            iCol1 = .Cells(1, Columns.Count).End(xlToLeft).Column
            iOK = 0
            For x = 2 To iRow1
                If .Cells(x, 2) = Cells(iRow, 1) Then
                    For y = 3 To iCol1
                        If .Cells(1, y) = Cells(iRow, 3) Then
                            dDate = Cells(iRow, 4)
                            For Z = y To iCol1
                                If .Cells(1, Z) >= Cells(iRow, 3) And .Cells(1, Z) <= Cells(iRow, 4) Then
                                    Select Case Len(Cells(iRow, 5))
                                        Case Is > 0
                                            If .Cells(x, Z).Comment Is Nothing Then .Cells(x, Z).AddComment
                                            .Cells(x, Z).Comment.Text CStr(Cells(iRow, 5))
                                        Case 0
                                            If .Cells(x, Z).Comment Is Nothing Then .Cells(x, Z).AddComment
                                            .Cells(x, Z).Comment.Delete
                                    End Select
                                End If
                            Next
                            iOK = 1
                            Exit For
                        End If
                    Next
                End If
                If iOK = 1 Then Exit For
            Next
        End With
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+

Bonjour à vous deux,

avant tout merci pour votre rapidité à tous les deux.

J'ai un soucis avec ta macro SabV. Jj'ai un code d'erreur d’exécution 13 qui apparait sur la ligne "With Sheets("2018").Cells(ligne, colonne)" ce qui fait que je ne peux pas tester la macro

Pour ta macro curulis57, elle correspond à ce que je veux mais (bien sur fallait bien un "mais"), est-il possible que le commentaire soit uniquement sur le premier jour de la période et non sur l’ensemble des jours. Par exemple pour la période du 01/01/2018 au 05/01/2018, le commentaire apparait uniquement sur la cellule du 1er janvier 2018 et non pas sur les cellules correspondants au 1, 2, 3, 4 et 5 janvier 2018

Encore merci et à très vite

PEV

Salut PEV,

voici la correction..

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("E:E")) Is Nothing Then
    iRow = Target.Row
    If Cells(iRow, 1) <> "" Then
        With Worksheets("2018")
            iRow1 = .Range("B" & Rows.Count).End(xlUp).Row
            iCol1 = .Cells(1, Columns.Count).End(xlToLeft).Column
            iOK = 0
            For x = 2 To iRow1
                If .Cells(x, 2) = Cells(iRow, 1) Then
                    For y = 3 To iCol1
                        If .Cells(1, y) = Cells(iRow, 3) Then
                            dDate = Cells(iRow, 4)
                                Select Case Len(Cells(iRow, 5))
                                    Case Is > 0
                                        If .Cells(x, y).Comment Is Nothing Then .Cells(x, y).AddComment
                                        .Cells(x, y).Comment.Text CStr(Cells(iRow, 5))
                                    Case 0
                                        If .Cells(x, y).Comment Is Nothing Then .Cells(x, y).AddComment
                                        .Cells(x, y).Comment.Delete
                                End Select
                            iOK = 1
                            Exit For
                        End If
                    Next
                End If
                If iOK = 1 Then Exit For
            Next
        End With
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A+

Bonjour Curulis57

Merci pour la correction. ça marche parfaitement. Je vais clôturer ce post, mais je me permettrais de revenir vers toi si jamais je découvre un autre PB auquel je n"étais pas encore confronté.

Merci encore beaucoup

Bonne journée

PEV