Déplacer automatiquement les commentaires pour ne pas cacher les autres cellules

Etienne2323

XLDnaute Impliqué
Bonjour à tous,
j'aimerais savoir si vous auriez une idée sur comment procéder pour déplacer automatiquement, par VBA, des commentaires (qui sont toujours visibles) de sorte que ces derniers ne cachent pas le contenu d'autres cellules. Je doit donc les déplacer pour qu'ils soient le plus près possible de la cellule à laquelle ils sont rattachés, et ce, sans les sortir de la zone d'impression (zone d'impression = A1 à AH30).

Merci beaucoup,

Cordialement,

Étienne
 

Pièces jointes

  • Transactions.xls
    260.5 KB · Affichages: 106
  • Transactions.xls
    260.5 KB · Affichages: 117
  • Transactions.xls
    260.5 KB · Affichages: 116

Etienne2323

XLDnaute Impliqué
Re : Déplacer automatiquement les commentaires pour ne pas cacher les autres cellules

Salut Hippolite, le forum,
merci de la piste. J'avais déjà traversé la bible de J. Boisgontier avant de poster, mais sans succès. J'arrive très bien à déplacer les commentaires avec les propriétés .Top et .Left. J'ignore encore si c'est la seule manière de procéder ... Par contre, cela ne me permet pas de voir si la cellule sous le commentaire est vide ou non. Je n'arrive donc pas à savoir quel serait l'endroit le plus propice pour déplacer mon commentaire (à savoir l'emplacement vide le plus près de ma cellule).

Des idées ?

Merci encore,

Cordialement,

Étienne
 

Hippolite

XLDnaute Accro
Re : Déplacer automatiquement les commentaires pour ne pas cacher les autres cellules

Re,
Trouver un emplacement libre me semble difficile, en revanche tu peux jouer sur les couleurs et la transparence pour que le commentaire et les cellules soient simultanément visibles. Si tu privilégie les cellules, mets le commentaire en image de fond.
Top, Left, Height, et Width + la taille des cellules devraient permettre de connaître les cellules recouvertes.
A+
 

Etienne2323

XLDnaute Impliqué
Re : Déplacer automatiquement les commentaires pour ne pas cacher les autres cellules

Bonjour Hippolite, le forum,
pour ceux que mon problème pourrait intéresser, voici comment je l'ai réglé. J'ai créé une macro qui incrémente le rayon autour de la cellule qui contient le commentaire jusqu'à ce qu'une plage assez grande pour recevoir le commentaire soit libre. Voici le code :

VB:
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

Cordialement,

Étienne
 

Etienne2323

XLDnaute Impliqué
Re : Déplacer automatiquement les commentaires pour ne pas cacher les autres cellules

Rebonjour,
voici le fichier contenant le code VBA.

En fait, j'en profite pour demander à tous les bons Samaritains qui passeront par içi si vous voyez une manière d'optimiser ce code.

Merci à tous,

Cordialement,

Étienne
 

Pièces jointes

  • Transactions.xls
    276 KB · Affichages: 121
  • Transactions.xls
    276 KB · Affichages: 129
  • Transactions.xls
    276 KB · Affichages: 132

DoubleZero

XLDnaute Barbatruc
Re : Déplacer automatiquement les commentaires pour ne pas cacher les autres cellules

Bonjour à toutes et à tous,

...pour ceux que mon problème pourrait intéresser, voici comment je l'ai réglé...

@ Etienne2323,

Un grand Merci :) pour ce partage de code que je suis bien incapable d'optimiser :eek:... et que je n'aurais su créer :eek:...

Son résultat pourrait-il donner plus grande satisfaction s'il était agrémenté du code de HASCO, récemment déposé ?

Bon après-midi :D.
 

Etienne2323

XLDnaute Impliqué
Re : Déplacer automatiquement les commentaires pour ne pas cacher les autres cellules

Salut DoubleZero, le forum,
c'est drôle que vous me parliez de ces lignes (.Placement = xlMoveAndSize et .TextFrame.AutoSize = True), je les ai intégré à mon code il y a de ça environ 1 heure. Cela me prouve encore une fois la pertinence des propos de notre ami Hasco.

Effectivement, c'est un apport très judicieux puisque l'on arrive à minimiser la taille du commentaire tout en modifiant les paramètres par défaut.

C'est toujours un plaisir de partager du code avec des gens qui savent l'apprécier autant que moi :)

Sur ce, bonne fin de journée

Cordialement,

Étienne
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 927
Membres
101 842
dernier inscrit
seb0390