Option Explicit
Sub Rayon_de_commentaires()
Dim cmt As Comment
Dim Ma_Cellule
Dim Gauche As Integer, Largeur As Integer, Haut As Integer, Hauteur As Integer, i As Integer, j As Integer
Dim Hauteur_de_cellule As Integer, Nb_Cellule_Haut As Single, Nb_Cellule_Large As Single
Dim La_Largeur As Single
Dim Plage(1 To 4) As Range, Cel As Range, Cel2 As Range, Plage_Verif As Range
Dim Ligne_Cellule As Integer, Colonne_Cellule As Integer, DC As Integer
Dim Plage_Trouvee As Byte, Switch_Verif As Byte, Switch_Verif2 As Byte
Dim Ligne_de_la_Cel As Integer, Colonne_de_la_Cel As Integer, NN As Integer
Application.ScreenUpdating = False
For Each cmt In ActiveSheet.Comments
Ma_Cellule = cmt.Parent.Address
Range(Ma_Cellule).Select
'Déterminer les paramètres du commentaire
Gauche = cmt.Shape.Left
Haut = cmt.Shape.Top
Largeur = cmt.Shape.Width
Hauteur = cmt.Shape.Height
'Déterminer les paramètres ligne et colonne de la cellule contenant le commentaire
Ligne_Cellule = ActiveCell.Row 'Ligne
Colonne_Cellule = ActiveCell.Column 'Colonne
'On va aller déterminer le nombre de cellules vides de haut qu'on a besoin
Hauteur_de_cellule = Cells(150, 1).EntireRow.Height 'Hauteur de notre cellule de référence
Nb_Cellule_Haut = Application.WorksheetFunction.RoundUp((Hauteur / Hauteur_de_cellule), 0) 'Nombre de cellules nécessaires
'On va aller déterminer le nombre de cellules vides de large qu'on a besoin
La_Largeur = 0 'Initialise
DC = Cells(1, 256).End(xlToLeft).Column 'Détermine la dernière colonne de l'onglet
For i = 4 To DC 'On va boucler l'ensemble des colonnes pour aller chercher la largeur moyenne
La_Largeur = La_Largeur + Cells(1, i).EntireColumn.Width 'Incrémente la variable
Next i 'Suivante
Nb_Cellule_Large = La_Largeur / (DC - 3) 'Trouve la moyenne
Nb_Cellule_Large = Application.WorksheetFunction.RoundUp((Largeur / Nb_Cellule_Large), 0) 'Arrondi à l'entier supérieur
'On va aller faire un rayon autour de la cellule active pour déterminer quel serait le chemin le moins long
'pour déplacer le commentaire
Plage_Trouvee = 0
For i = 1 To 100
'Coté en haut
Set Plage(1) = Range(Cells(Ligne_Cellule - (1 * i), Colonne_Cellule - (1 * i)), Cells(Ligne_Cellule - (1 * i), Colonne_Cellule + (1 * i)))
'Coté en bas
Set Plage(2) = Range(Cells(Ligne_Cellule + (1 * i), Colonne_Cellule - (1 * i)), Cells(Ligne_Cellule + (1 * i), Colonne_Cellule + (1 * i)))
'Coté gauche
Set Plage(3) = Range(Cells(Ligne_Cellule - (1 * i), Colonne_Cellule - (1 * i)), Cells(Ligne_Cellule + (1 * i), Colonne_Cellule - (1 * i)))
'Coté droit
Set Plage(4) = Range(Cells(Ligne_Cellule - (1 * i), Colonne_Cellule + (1 * i)), Cells(Ligne_Cellule + (1 * i), Colonne_Cellule + (1 * i)))
For j = 1 To 4 'On va boucler sur chacun des 4 côtés pour trouver les premières cellules vides qui remplissent les critères
For Each Cel In Plage(j) 'Pour chacune des cellule de mon côté
NN = 1 'Variable pour les nombres négatifs.
If j = 1 Or j = 3 Then 'S'il s'agit des côtés gauche ou haut, alors on va avoir besoin de la variable négative
NN = -1 'Variable négative
Else
NN = 1 'Variable positive
End If
If Cel.Value = "" Then 'Si la cellule de recherche est vide, alors ...
Ligne_de_la_Cel = Cel.Row 'Détermine sa ligne
Colonne_de_la_Cel = Cel.Column 'Détermine sa colonne
'Set la page de vérification en fonction de l'espace qu'on aurait besoin en largeur pour fitter le commentaire
Set Plage_Verif = Range(Cells(Ligne_de_la_Cel, Colonne_de_la_Cel), Cells(Ligne_de_la_Cel, Colonne_de_la_Cel + Nb_Cellule_Large - 1))
Switch_Verif = 0 'Initialise une variable
For Each Cel2 In Plage_Verif 'Pour chacune des cellules de la plage de vérif (en largeur)
If Cel2.Value <> "" Then 'Si la cellule est différente de vide, alors ce ne sera pas cette plage qui sera utilisée
Switch_Verif = 1 'Tourne la switch de vérif à 1
Exit For 'Sort de cette boucle
End If
Next Cel2 'Prochaine cellule de notre plage de vérif
'On a peut-être trouvé notre plage pour la largeur
If Switch_Verif = 0 Then 'Si la plage horizontale (en largeur) est vide, alors il faut aller voir si on a assez de place en hauteur
If NN = 1 Then 'On va setter notre plage de vérification en hauteur
Set Plage_Verif = Range(Cells(Ligne_de_la_Cel, Colonne_de_la_Cel), Cells(Ligne_de_la_Cel + ((Nb_Cellule_Haut - 1) * NN), Colonne_de_la_Cel + Nb_Cellule_Large - 1))
Else
Set Plage_Verif = Range(Cells(Ligne_de_la_Cel - (Nb_Cellule_Haut - 1), Colonne_de_la_Cel), Cells(Ligne_de_la_Cel, Colonne_de_la_Cel + Nb_Cellule_Large - 1))
End If
Switch_Verif2 = 0 'Initialise la variable
For Each Cel2 In Plage_Verif 'Si toutes les cellules nécessaires sont vides, alors on a trouvé notre plage
If Cel2.Value <> "" Then
Switch_Verif2 = 1
Exit For
End If
Next Cel2
'On a trouvé notre plage pour déplacer le commentaire si la switch est restée à 0
If Switch_Verif2 = 0 Then
If NN = 1 Then 'Si on déplace sur le coté droit ou en bas ...
cmt.Shape.Left = Cells(Ligne_de_la_Cel, Colonne_de_la_Cel).Left 'Déplace le commentaire vers la gauche
cmt.Shape.Top = Cells(Ligne_de_la_Cel, Colonne_de_la_Cel).Top 'Déplace le commentaire vers le haut
Plage_Trouvee = 1 'On dit qu'on a trouvé la plage, dont on peut sortir des boucles
For Each Cel2 In Plage_Verif 'On va mettre des espacements dans les cellules de notre zone de réception
'pour empêcher qu'un autre commentaire vienne chevaucher le commentaire qu'on vient de déplacer
Cel2.Value = " " 'Espacement
Next Cel2 'Prochaine cellule
Exit For 'Sort de la boucle
Else 'Si c'est en haut ou à gauche, alors ...
cmt.Shape.Left = Cells(Ligne_de_la_Cel - (Nb_Cellule_Haut - 1), Colonne_de_la_Cel).Left 'Déplace le commentaire vers la gauche
cmt.Shape.Top = Cells(Ligne_de_la_Cel - (Nb_Cellule_Haut - 1), Colonne_de_la_Cel).Top 'Déplace le commentaire vers le haut
Plage_Trouvee = 1 'On dit qu'on a trouvé la plage, dont on peut sortir des boucles
For Each Cel2 In Plage_Verif 'On va mettre des espacements dans les cellules de notre zone de réception
'pour empêcher qu'un autre commentaire vienne chevaucher le commentaire qu'on vient de déplacer
Cel2.Value = " " 'Espacement
Next Cel2 'Prochaine cellule
Exit For 'Sort de la boucle
End If
End If
End If
End If
Next Cel
If Plage_Trouvee = 1 Then Exit For 'Sort de la boucle
Next j
If Plage_Trouvee = 1 Then
Plage_Trouvee = 0 'Réinitialise la variable pour la prochaine utilisation
Exit For 'Sort de la boucle
End If
Next i
Next
'Vide nos sluts de mémoire
Set Plage_Verif = Nothing
Set Plage(1) = Nothing
Set Plage(2) = Nothing
Set Plage(3) = Nothing
Set Plage(4) = Nothing
End Sub