[VBA] Note par double clique

Bonjour ,

J'ai trouvé un superbe script pour insérer des commentaires par double-clique

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
textee = Target.Value & " " & InputBox("Commentaire")
With Target
If .Comment Is Nothing Then
.AddComment (textee)
End If
SendKeys "%im"
End With
Target.Font.Bold = True
Target.Offset(1, 0).Select
End If
End Sub

Est-ce possible d'élargir la zone où est noté "Commentaire" pour écrire un peu plus que deux ou trois mots ?
Mon but serait de donner des indications pour les commentaires et il me faudrait également pouvoir écrire ça sur plusieurs lignes (pas besoin de plus de 6).

Est-ce faisable ?

Bonjour toutes et tous

un petit bidouillage ci-dessous

Option Explicit
'déclaration variables
Dim textee, textee1, textee2
' il suffit de rajouter textee3, 4,5 et 6
' après de mettre un retour à la ligne  & vbcrlf
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
textee = Target.Value & " " & InputBox("Commentaire")
textee1 = Target.Value & " " & InputBox("Commentaire")
textee2 = Target.Value & " " & InputBox("Commentaire")
With Target
If .Comment Is Nothing Then
.AddComment (textee) &  vbcrlf & (textee1)& vbcrlf & (textee2)
End If
SendKeys "%im"
End With
Target.Font.Bold = True
Target.Offset(1, 0).Select
End If
End Sub

crdlt,

André

Bonjour,

Un essai avec une zone de texte [affichée / masquée] (un TextBox) :

Double clic dans une cellule : affiche la zone de texte pour saisie (permet de modifier un commentaire existant)

Entrée dans la zone de texte : valide le commentaire et masque la zone de texte. Note : si la zone de texte est effacée, Entrée efface le commentaire.

Échap. dans la zone de texte ou Clic sur une autre cellule : masque la zone de texte sans modifier le commentaire

Pour saisir un retour à la ligne dans la zone de texte : Maj+Entrée ou Ctrl+Entrée

Je n'ai pas essayé mais la longueur du texte est peut-être limitée à 255 caractères.

Le code :

Option Explicit
Public cible As Range
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
    Set Me.cible = Target
    Call SaisirCommentaire
    Cancel = True
  End If
End Sub
Private Sub SaisirCommentaire()
  Me.cible.Font.Bold = False
  With Me.TextBox1
    .Top = Me.cible.Top
    .Left = Me.cible.Offset(0, 1).Left + 10
    .MultiLine = True
    .Visible = True
    If Me.cible.Comment Is Nothing Then
      .Text = Me.cible.Text & " "
    Else
      .Text = Me.cible.Comment.Text
    End If
  End With
End Sub
Private Sub TextBox1_Change()
  Me.TextBox1.Activate
End Sub
Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal shift As Integer)
  If KeyCode = 27 Then ActiveCell.Activate
  If KeyCode = 13 And shift = 0 Then
    With Me.cible
      If Not .Comment Is Nothing Then .Comment.Delete
      If Me.TextBox1.Text <> "" Then
        .AddComment Me.TextBox1.Text
        .Font.Bold = True
      End If
      .Offset(1).Activate
    End With
  End If
End Sub
Private Sub TextBox1_LostFocus()
  Me.TextBox1.Visible = False
End Sub

Bonjour,

Merci pour vos deux réponses, elles sont toutes deux différentes et intéressantes !
Malheureusement ce n'est pas exactement ce que je recherche .
J'aimerais plutôt quelque chose qui ressemble à ça, mais où je pourrais mettre des phrases plus longues que dans cet exemple :

Bonjour,

Peut-être dans ce style là... avec un textbox
voir fichier joint

pas oublier d'activer les macros pour que cela fonctionne

Slts

Merci !

Je pense que ça ira très bien !
Je n'ai juste pas réussi à faire en sorte que le code soit applicable de A1 à A5 uniquement.

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
On Error Resume Next
If target.Column = 1 Then Exit Sub
Commentaires.show
End Sub

Quelqu'un à la solution ?

Bonjour tout le monde,

Je n'ai juste pas réussi à faire en sorte que le code soit applicable de A1 à A5 uniquement.

Peut-être ainsi:

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
 On Error Resume Next
  If Not Application.Intersect(target, Range("A1:A5")) Is Nothing Then
   Commentaires.show
  End If
End Sub

Utilisation de la méthode Intersect

Autre possibilité:

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
 On Error Resume Next
  If target.Column > 1 Then Exit Sub
  If target.Row > 5 Then Exit Sub
   Commentaires.show
End Sub

Cordialement,

C'est parfait, merci beaucoup !