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
  • Partager ce contenu :
Vos réponses
Trier par : date / pertinence
MichD
Le #26554040
Bonjour,
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
Emile63
Le #26554047
Le Saturday, September 5, 2020 à 3:56:43 PM UTC+2, MichD a écrit  :
Bonjour,
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 :)
Poster une réponse
Anonyme