Discussion :

[persjussysylvain]

Bonjour,

Voici un code qui me permet d'insérer les valeurs de cellules dans un commentaire d'une autre cellule

Je voudrais que ce commentaire reste à la même position même si je masque des lignes par la suite
J'ai une procédure qui met permet de masquer des lignes au clic droit sur certaines cellules et alors la position du commentaire se séplace.
Voir les images suivantes :

Bon positionnement des commentaires :


Commentaires déplacés suites à des lignes masquées


Voici mon code :

Option Explicit


Code pour masquer des lignes (pour info => fonctionne trés bien")

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_BeforeRightClick(ByVal R As Range, Cancel As Boolean)
  If Intersect(R, [B56:B191]) Is Nothing Or (R.Row - 2) Mod 9 Then Exit Sub
  Dim P As Range
  Cancel = True
  Set P = R(3, 1).Resize(7)
  P.EntireRow.Hidden = Not P.EntireRow.Hidden
  If P.EntireRow.Hidden = True Then Exit Sub
  R(4, 1).Resize(3).EntireRow.Hidden = True 'pour cacher
  R(9, 1).EntireRow.Hidden = True
End Sub

Code pour insérer des commentaires

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim Cel As Range
    Dim Com As Comment
    Dim Chaine As String
    Dim Val1 As Integer
    Dim Val2 As Integer
 
    Val1 = 8: Val2 = 0
 
    If Target.Row < 56 Then Exit Sub 'seulement à partir de la ligne 56
    If Target.Count > 1 Then Exit Sub 'seulement une seule cellule
    If Target.Row Mod 9 <> Val1 And Target.Row Mod 9 <> Val2 Then Exit Sub
    If Target.Column > 390 Then Exit Sub 'seulement jusqu'à la colonne 390
 
    If Target.Row Mod 9 = Val1 Then Set Cel = Target.Offset(-6) Else Set Cel = Target.Offset(-7)
 
    With Cel
 
        Set Com = .Comment
 
        If Not Com Is Nothing Then Com.Delete
 
        If Target.Row Mod 9 = Val1 Then
 
            If Target.Value <> "" Then Chaine = Target.Value
            If Target.Offset(1).Value <> "" Then Chaine = Chaine & IIf(Target.Value <> "", vbCrLf & Target.Offset(1).Value, Target.Offset(1).Value)
 
        Else 'sinon, pour Val2
 
            If Target.Value <> "" Then Chaine = Target.Value
            If Target.Offset(-1).Value <> "" Then Chaine = Target.Offset(-1).Value & IIf(Target.Value <> "", vbCrLf & Chaine, "")
 
        End If
 
        If Chaine <> "" Then
 
            Set Com = .AddComment
            Com.Text Chaine
            Com.Shape.TextFrame.AutoSize = True
            Com.Visible = True '<--- le commentaire reste toujours affiché
 
        End If
 
    End With
 
End Sub

Ci-joint les 2 fichiers exemples correspondant aux images

En faisant un clic droit sur un commentaire et en sélectionnant "Format de commentaire" et "Propriétés" et "Déplacer sans dimensionner avec les cellules"
=> alors cela fonctionne mais ca ne marche que pour un commentaire à la fois et pas pour tout les commentaires.
Mais ca serait la meilleure solution si on peut mettre cette propriété pour tous les commentaires car je pourrais déplacer manuellement le commetaire si besoin et il resterait à cette place quand des lignes sont masquées ou affichées.
Est-il donc possible de mettre cette propriété pour tous les commentaires svp ?

Pouvez-vous m'aider svp ?

Je vous remercie


Cordialement