XL 2016 Affichage d'une date automatiquement en fonction du remplissage d'une ligne

fanch55 à dit:

Bonjour,Je ne sais pas trop si j'ai bien compris la demande.
Dans le code ci-dessous à mettre dans le code de la feuille,
la date est automatiquement renseignée si elle ne l'était pas.
Chaque colonne se voit attribuée d'un commentaire indiquant la date à laquelle elle a été modifiée.

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Elem As Range, Plage As Range
Application.EnableEvents = False
    Set Plage = Range("A5:K" & Cells(Rows.Count, "B").End(xlUp).Row)
   
    For Each Elem In Target.Cells
        If Not Intersect(Elem, Plage) Is Nothing Then
            Select Case True
            Case Elem.Column = 2:   ' rien
            Case Elem.Column = 1 And Elem.Value = "":
            ' si le jour est effacé, la ligne entière du tableau aussi sauf la colonne B
                Save = Cells(Elem.Row, "B")
                    Range("A:K").Rows(Elem.Row).ClearContents
                    Range("A:K").Rows(Elem.Row).ClearComments
                Cells(Elem.Row, "B") = Save
                Exit For
            Case Else
                ' sinon on met la date du jour dans le commentaire
                Set_Comment Elem, CStr(Date), False
                ' si la date n'est pas renseignée, on y met celle du jour
                If Cells(Elem.Row, "A") = vbNullString Then Cells(Elem.Row, "A") = Date
            End Select
        End If
    Next
Application.EnableEvents = True
End Sub

Sub Set_Comment(Cell As Range, _
                Optional Commentaire As String, _
                Optional Visible As Boolean = True, _
                Optional Intérieur As Boolean)
On Error GoTo Exit_Sub
    If Commentaire = vbNullString Then
        If Not Cell.Comment Is Nothing Then Cell.ClearComments
    Else
        If Cell.Comment Is Nothing Then Cell.AddComment
        With Cell.Comment
            .Text Text:=Commentaire
            .Visible = True
                .Shape.TextFrame.AutoSize = True
                .Shape.TextFrame.Characters.Font.Italic = True
                .Shape.TextFrame.HorizontalAlignment = xlHAlignCenter
                .Shape.TextFrame.VerticalAlignment = xlVAlignCenter
                .Shape.Top = Cell.Top + 2
                Select Case True
                    Case Not Visible:   .Shape.Left = Cell.Left + Cell.Width - .Shape.Width - 5
                    Case Intérieur:     .Shape.Left = Cell.Left + Cell.Width - .Shape.Width - 5
                    Case Else:          .Shape.Left = Cell.Left + Cell.Width + 15
                End Select
            .Visible = Visible
        End With
    End If
    'Cell.Activate
Exit_Sub:
    Err.Clear
    On Error GoTo 0
End Sub

Cliquez pour agrandir...