zoom sur une cellule contenant une date

[dam0326]

Bonjour,

Pour faire un zoom sur des cellules lorsque je passe le curseur, j’ai utilisé la macro suivante :

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’Créaction commentaire
.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.Value
.Comment.Shape.TextFrame.AutoSize = True
End If
End With
End If
End Sub

Cette macro fonctionne très bien sauf quand j’ai une date au format JJ/MM/AAAA, qu’est ce je dois modifier pour que les dates soient prises en compte ?

Merci pour votre aide par avance,

Damien

 

[DoubleZero]

Re : zoom sur une cellule contenant une date

Bonjour, dam0326, le Forum,

Peut-être ainsi :

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

A bientôt 🙂

P. S. : Bonjour, Staple1600 😀

 

[Staple1600]

Re : zoom sur une cellule contenant une date

Bonosir à tous , 00 😉

Puisqu'endives il y a déjà, j'en rajoute une petite lichée 😉

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

 

[Si...]

Re : zoom sur une cellule contenant une date

... à tous , 00 😉 --------------------------> et 😀
...
Puisqu'endives il y a déjà, j'en rajoute une petite lichée 😉

Leur intérêt est d'éviter les répétitions non ? De plus on sait de quoi qu'on cause !
Pour éviter l'erreur plutôt que de la gérer et à ma sauce

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