VBA, boucle pour corriger le placement des commentaires
Le
Emile63

Bonjour à tous,
Dans des feuilles que je manipule souvent (masquer, trier, ajouter des lign=
es) j'ai le souci que le cadre des commentaires que j'insère à me=
s cellules se déplacent (je ne sais pas trop pourquoi) plus bas ou plu=
s à droites d'où ils étaient initialement jusqu'au point de =
me créer un message d'erreur me compliquant les tâches quand je m=
asque des colonnes :
Microsoft Excel:
Vous ne pouvez pas déplacer des objets en dehors de la feuille.
J'ai trouvé dans un site dédié les deux marcos suivantes, l'=
une ajuste et redimensionne les commentaires des cellules et l'autre le (re=
)place près de la cellule. Elles fonctionnent bien, et on en partie r=
ésolu mon souci. Mais pour gagner du temps j'aimerais bien les unir en=
une seule procédure plutôt que de lancer les deux, j'ai bien ess=
ayé mais sans succès.
-Est-ce que quelqu'un veut bien me venir en aide ?
Je vous remercie d'avance pour votre aide.
Emile
Sub ResetComments()
'(Re)Place les commentaires en haut, à droite de la cellule
Dim cmt As Comment
For Each cmt In ActiveSheet.Comments
cmt.Shape.Top = cmt.Parent.Top + 5
cmt.Shape.Left = cmt.Parent.Offset(0, 1).Left + 5
Next
End Sub
Sub ResizeCommentsInSelection()
'Redimensionne les commentaires par rapport au texte
Dim mycell As Range
Dim myRng As Range
Dim lArea As Long
Set myRng = Selection
For Each mycell In myRng.Cells
If Not (mycell.Comment Is Nothing) Then
With mycell.Comment
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
.Shape.Height = (lArea / 200) * 1.2
End If
End With
End If
Next mycell
End Sub
Dans des feuilles que je manipule souvent (masquer, trier, ajouter des lign=
es) j'ai le souci que le cadre des commentaires que j'insère à me=
s cellules se déplacent (je ne sais pas trop pourquoi) plus bas ou plu=
s à droites d'où ils étaient initialement jusqu'au point de =
me créer un message d'erreur me compliquant les tâches quand je m=
asque des colonnes :
Microsoft Excel:
Vous ne pouvez pas déplacer des objets en dehors de la feuille.
J'ai trouvé dans un site dédié les deux marcos suivantes, l'=
une ajuste et redimensionne les commentaires des cellules et l'autre le (re=
)place près de la cellule. Elles fonctionnent bien, et on en partie r=
ésolu mon souci. Mais pour gagner du temps j'aimerais bien les unir en=
une seule procédure plutôt que de lancer les deux, j'ai bien ess=
ayé mais sans succès.
-Est-ce que quelqu'un veut bien me venir en aide ?
Je vous remercie d'avance pour votre aide.
Emile
Sub ResetComments()
'(Re)Place les commentaires en haut, à droite de la cellule
Dim cmt As Comment
For Each cmt In ActiveSheet.Comments
cmt.Shape.Top = cmt.Parent.Top + 5
cmt.Shape.Left = cmt.Parent.Offset(0, 1).Left + 5
Next
End Sub
Sub ResizeCommentsInSelection()
'Redimensionne les commentaires par rapport au texte
Dim mycell As Range
Dim myRng As Range
Dim lArea As Long
Set myRng = Selection
For Each mycell In myRng.Cells
If Not (mycell.Comment Is Nothing) Then
With mycell.Comment
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
.Shape.Height = (lArea / 200) * 1.2
End If
End With
End If
Next mycell
End Sub
Essaie ceci :
'---------------------------------------------------
Sub ResetComments()
'Dimensionne et (Re)Place les commentaires en haut,
'à droite de la cellule
Dim cmt As Comment, lArea As Long
For Each cmt In ActiveSheet.Comments
With cmt
.Shape.Top = .Parent.Top + 5
.Shape.Left = .Parent.Offset(0, 1).Left + 5
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 300 Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = 200
.Shape.Height = (lArea / 200) * 1.2
End If
End With
Next
End Sub
'---------------------------------------------------
MichD
Merci et bonne journée :)