VBA, boucle pour corriger le placement des commentaires
2 réponses
Emile63
Bonjour =C3=A0 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=C3=A8re =C3=A0 me=
s cellules se d=C3=A9placent (je ne sais pas trop pourquoi) plus bas ou plu=
s =C3=A0 droites d'o=C3=B9 ils =C3=A9taient initialement jusqu'au point de =
me cr=C3=A9er un message d'erreur me compliquant les t=C3=A2ches quand je m=
asque des colonnes :
Microsoft Excel:=20
Vous ne pouvez pas d=C3=A9placer des objets en dehors de la feuille.
J'ai trouv=C3=A9 dans un site d=C3=A9di=C3=A9 les deux marcos suivantes, l'=
une ajuste et redimensionne les commentaires des cellules et l'autre le (re=
)place pr=C3=A8s de la cellule. Elles fonctionnent bien, et on en partie r=
=C3=A9solu mon souci. Mais pour gagner du temps j'aimerais bien les unir en=
une seule proc=C3=A9dure plut=C3=B4t que de lancer les deux, j'ai bien ess=
ay=C3=A9 mais sans succ=C3=A8s.
-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, =C3=A0 droite de la cellule
Dim cmt As Comment
For Each cmt In ActiveSheet.Comments
cmt.Shape.Top =3D cmt.Parent.Top + 5
cmt.Shape.Left =3D 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 =3D Selection
For Each mycell In myRng.Cells
If Not (mycell.Comment Is Nothing) Then
With mycell.Comment
.Shape.TextFrame.AutoSize =3D True
If .Shape.Width > 300 Then
lArea =3D .Shape.Width * .Shape.Height
.Shape.Width =3D 200
.Shape.Height =3D (lArea / 200) * 1.2
End If
End With
End If
Next mycell
End Sub
---------------------------------------------------------------
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
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
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
'---------------------------------------------------
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 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 :)
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
'---------------------------------------------------
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