XL 2021 ListBox1 : format texte date et enregistrement sans ma cellule

Private Sub ListBox1_Change()
  If ListBox1 Like ("…*") Or ListBox1 = ("") Then Exit Sub
  With ActiveCell.Offset(0, 2)
    .Value = Replace(.Value, Format(Date, "dd.mm.yy "), "")
    .Value = Format(Now, "dd.mm.yy hh:mm:ss") & " : " & ListBox1 & " - " & .Value
    .Font.Bold = False
    .Font.Underline = xlUnderlineStyleNone
    .Characters(1, 8).Font.Bold = True
    .Characters(1, 8).Font.Underline = xlUnderlineStyleSingle
  End With
  Cells(ActiveCell.Row, 1).Select
  Unload Me
  Application.EnableEvents = True
End Sub

Private Sub ListBox1_Change()
  If ListBox1 Like "…*" Or ListBox1 = "" Then Exit Sub
  Dim manuel As Boolean, i%
  If ListBox1 = "Autre - voir commentaires" Then manuel = True
  With ActiveCell.Offset(0, 2)
    .Value = Replace(.Value, Format(Date, "dd.mm.yy "), "")
    .Value = Format(Now, "dd.mm.yy hh:mm:ss") & " : " & IIf(manuel, "", ListBox1) & " - " & .Value
    .Font.Bold = False
    .Font.Underline = xlUnderlineStyleNone
    For i = 1 To Len(.Value) - 7
      If Mid(.Value, i, 8) Like "##.##.##" Then
        .Characters(i, 8).Font.Bold = True
        .Characters(i, 8).Font.Underline = xlUnderlineStyleSingle
        i = i + 7
      End If
    Next
    If manuel Then
        .Cells.Select
        CreateObject("WScript.Shell").SendKeys "{F2}{LEFT " & Len(.Cells) - 20 & "}" 'positionne le curseur dans la cellule
    Else
        Cells(ActiveCell.Row, 1).Select
    End If
  End With
  Unload Me
  Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal R As Range)
If Intersect(R, Range("k7:k7")) Is Nothing Then
    ActiveWindow.Zoom = 100
    ActiveWindow.ScrollColumn = 1
Else
    ActiveWindow.Zoom = 180
    ActiveWindow.ScrollColumn = 5
End If
If Not Intersect(R, Range("i7:i7")) Is Nothing Then affecte.Show
End Sub