Discussion :

[Le_passant]

Bonjour,

j'ai besoin de redimensionner et repositionner tous les commentaires d'un classeur au voisinage de leur cellule de référence.
Voilà où j'en suis de mes tentatives, sans succès pour l'instant.
Quelque chose pêche dans mon raisonnement, mais je ne vois pas quoi.

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
Sub RepositionComment()
Dim c As Range
 
Range("A1").Select
Selection.SpecialCells(xlCellTypeComments).Select
With Selection
    For Each c In Selection
        c.Comment.Shape.Select True
        c.Comment.Shape.Placement = xlMove
        c.ShapeRange.Left = Selection.Width * 1.2
        c.ShapeRange.Top = Selection.Height * 0.8
        c.Comment.Shape.Select False
    Next
End With
End Sub

Merci de vos conseils.

[Invité]

Bonjour,

A essayer :

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
Sub RepositionCommentV2()
 
Dim Cellule As Range
 
       For Each Cellule In ActiveSheet.UsedRange.Cells
           If Not Cellule.Comment Is Nothing Then
                  With Cellule.Comment.Shape
                        .Placement = xlMove
                        .Left = .Width * 1.2
                        .Top = .Height * 0.8
                  End With
           End If
        Next Cellule
 
End Sub

Cordialement.

[Le_passant]

Bonjour,

merci pour la réponse.
Ce code positionne tous les commentaires aux mêmes coordonnées, ils se superposent.
Je n'ai pas eu le temps d'analyser pourquoi.

Je n'ai pas pu revenir plus tôt pour donner la solution finalement trouvée et opérationnelle.

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
Sub RepositionComment()
'macro destinée à replacer les commentaires au voisinage de leur cellule de référence
Dim c As Variant
 
    Range("A1").Select 'initialiser la sélection
    Selection.SpecialCells(xlCellTypeComments).Select 'sélectionner toutes les cellules ayant un commentaire rattaché
    With Selection
        c = ActiveCell
        For Each c In Selection
            If c.Comment Is Nothing Then
                GoTo suite
'                c.AddComment 'STOP DEV, à ne pas utiliser en réel
'                c.Comment.Text Text:="commentaire A1"
            End If
                v_comment = c.Comment.Text 'mémoriser le contenu du commentaire
                c.ClearComments 'effacer le commentaire
            If c.Comment Is Nothing Then
                c.AddComment 'créer nouveau commentaire
'c.Comment.Visible = Not c.Comment.Visible 'STOP DEV
                c.Comment.Text Text:=v_comment 'insérer le contenu mémorisé
            End If
suite:
        Next c 'passer à la cellule suivante de la sélection
    End With
End Sub

Les commentaires sont tous recréés avec leur contenu initial et se mettent à leur position par défaut.