zoom sur une cellule contenant une date

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect([B2:C7], Target) Is Nothing Then
        On Error Resume Next
        With Target
            .Comment.Delete
            If Target <> "" Then
                .AddComment
                .Comment.Shape.OLEFormat.Object.Font.Name = "Tverdana"
                .Comment.Shape.OLEFormat.Object.Font.Size = 12
                .Comment.Shape.OLEFormat.Object.Font.FontStyle = "Normal"
                .Comment.Text Text:=Target.Text
                .Comment.Shape.TextFrame.AutoSize = True
            End If
        End With
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect([B2:C7], Target) Is Nothing Then
        On Error Resume Next
        With Target
            .Comment.Delete
            If Target <> "" Then
'If Len(.Text) > 0 Then 'ou pour flatter l'endive ;-)
                .AddComment
                With .Comment.Shape.OLEFormat.Object.Font
                .Name = "Tverdana": .Size = 12: .FontStyle = "Normal"
                End With
                .Comment.Text .Text
                .Comment.Shape.TextFrame.AutoSize = -1
            End If
        End With
    End If
End Sub

Private Sub Worksheet_Change(ByVal R As Range)
  If Intersect(R, [B2:C7]) Is Nothing Then Exit Sub
  If Not R.Comment Is Nothing Then R.Comment.Delete
  If R = "" Then Exit Sub
  R.AddComment
  With R.Comment
    With .Shape.OLEFormat.Object.Font
      .Name = "Tverdana": .Size = 12: .FontStyle = "Normal"
    End With
    .Text Text:=R.Text: .Shape.TextFrame.AutoSize = 1  '<---- R.Text pour le commentaire
   End With
End Sub