Replacer commentaire

Bonjour,

J'ai un code qui me permet de repositionner mes commentaires quand je clique sur la cellule b55 ce qui permet de repositionner les commentaires à côté de sa cellule car les commentaires se déplacent quand je masque des lignes et des colonnes

        Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim sData$, iRow%, x%, y%
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
iRow = Target.Row
'

'
If Not Intersect(Target, Range("B55")) Is Nothing Then
    For x = 56 To 182 Step 9
        For y = Range("C1").Resize(Rows.Count, Columns.Count - 2).SpecialCells(xlCellTypeVisible).Column To Cells(55, Columns.Count).End(xlToLeft).Column
            Call SetComment(x, y)
        Next
    Next
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub

Public Sub SetComment(ByVal iTRow%, iTCol%)
'
Dim sData$
'
Cells(iTRow, iTCol).ClearComments
If Cells(iTRow + 6, iTCol) <> "" Then sData = LCase(Cells(iTRow + 6, iTCol))
If Cells(iTRow + 6, iTCol) <> "" Or Cells(iTRow + 7, iTCol) <> "" Then sData = sData & "-"
If Cells(iTRow + 7, iTCol) <> "" Then sData = sData & UCase(Cells(iTRow + 7, iTCol))
If Not Cells(iTRow + 2, iTCol).Comment Is Nothing Then sData = sData & IIf(sData = "", "*", " *")
If sData <> "" Then
    With Cells(iTRow, iTCol)
        .AddComment
        .Comment.Text sData
        .Comment.Shape.TextFrame.AutoSize = True
        .Comment.Visible = True
    End With
End If
'
End Sub

Ce code fonctionne uniquement pour les lignes en bleu sur la feuille 'stats repas" : lignes 58, 67, 76 etc DONC toutes les 9 lignes jusqu'à la ligne 184

Je voudrais svp replacer tous les commentaires mêmes les commentaires placé sur les autres lignes.

J'ai essayé de modifier cette ligne

For x = 56 To 182 Step 9 

par

For x = 56 To 182 Step 1

mais excel plante

Pouvez vous m'aider svp ?

Je vous remercie beaucoup

Cordialement

Bonjour,

si c'est juste pour replacer les Comments viv-à-vis la cellule,

à tester,

Sub Replace_Comments()
For Each cmt In ActiveSheet.Comments
    cmt.Shape.Top = Range(cmt.Parent.Address).Offset(0, 1).Top + 2
Next
End Sub

C'est parfait en vertical(top) mais le commentaire reste loin à l'horizontal(left)

C'est possible de reajuster le left svp ?

dans ce formlat la si possible, c'est à dire un peu en haut à droite de la cellule

With cell.Comment.Shape
                    .Left = Range(AdrCell).Offset(0, 1).Left ' le commentaire se place à droite de la cellule
                    .Top = Range(AdrCell).Offset(0, 1).Top 'le commentaire se place sur la même ligne que la cellule
                End With

Merci beaucoup

re,

à tester,

Sub Replace_Comments()
For Each cmt In ActiveSheet.Comments
    cmt.Shape.Top = Range(cmt.Parent.Address).Offset(0, 1).Top + 2
    cmt.Shape.Left = Range(cmt.Parent.Address).Offset(0, 1).Left + 2
Next
End Sub

C'est parfait

merci beaucoup

bonne soirée