Centrage d'image VBA

Bonjour !

Je souhaite que la macro suivante soit exécutée automatiquement lorsque la largeur de la colonne A est modifiée (depuis l'élargisseur avec le curseur et non depuis le menu spécifique, jsp si ça change quelque chose ou pas mais je préfère l'indiquer).

Sub img()
Dim obj As Shape, c As Range
For Each obj In ActiveSheet.Shapes
If obj.Type = msoPicture Then
Set c = obj.TopLeftCell
' Centrer horizontalement
obj.Left = c.Left + (c.Width - obj.Width) / 2
End If
Next obj
End Sub

Merci d'avance pour votre aide !!!

Bonsoir,

il n'y a pas de surveillance événementielle sur la modification de la largeur des colonnes, donc le côté automatique sur le changement de taille ne marchera pas. Par contre suit au changement de taille, l'utilisateur cliquera certainement sur une cellule quelconque de la feuille.

Et là il existe une surveillance événementielle : Selection_Change. Donc une fois la nouvelle sélection de cellule détectée vous lancez votre code de scan sur les objets afin de les centrer. Si la colonne concernée par "cette surveillance" est unique, vous pouvez même mettre en mémoire sa nouvelle taille, comme cela lors d'uun autre changement de cellule, vous faites un test sur sa taille afin de vérifier si elle est différente de sa taille "en mémoire" vous relancer le centrage, sinon vous ne le faites pas.

@ bientôt

LouReeD

Voir fichier joint :

Modifiez la taille de la colonne B, puis cliquez où vous voulez... Je ne suis pas sur de pouvoir faire mieux, à moins peut-être de jouer avec des API Windows ?

@ bientôt

LouReeD

Bonjour Nathan.D, LouReeD,

Pas besoin de macros pour cela. Faire en sorte que l'image déborde légèrement sur la ligne horizontale droite marquant la colonne.

Et que les propriétés de cette image ou de toutes les images de cette colonne soi(en)t avec la coche Déplacer et dimensionner avec les cellules.

Chaque fois que tu augmentera ou diminuera la largeur de la colonne l'image ou les images s'adapteront

Bonjour X Cellus,

Dans ce cas l'image n'est pas "centrée" mais elle est étirée ou comprimée avec déformation... Ce n'est pas ce que j'ai compris de la demande...

@ bientôt

LouReeD

Bonjour LouReeD,

J'ai essayé donné ton idée à chatgpt pour qu'il me fasse une macro mais cela ne fonctionne pas. Le fichier que tu m'a joint ne fonctionne pas non plus.
J'ai eu une autre idée, il pourrait y avoir un timer pour lancer la macro toutes les 1 secondes par exemple mais je n'arrive pas à l'automatiser pour qu'il se lance automatiquement et en répétition.
Tu saurais le faire ?
Voici la macro que j'ai trouvé :

Dim TimerActive As Boolean

Private Sub Workbook_Open()
StartTimer
End Sub

Sub StartTimer()
If Not TimerActive Then
TimerActive = True
' Définir le premier appel de la macro img() après 1 seconde
Application.OnTime Now + TimeValue("00:00:01"), "img", , True
End If
End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime NextTime:=False
TimerActive = False
End Sub

Sub img()
Dim obj As Shape, c As Range
For Each obj In ActiveSheet.Shapes
If obj.Type = msoPicture Then
Set c = obj.TopLeftCell
' Centrer horizontalement
obj.Left = c.Left + (c.Width - obj.Width) / 2
' Centrer verticalement
obj.Top = c.Top + (c.Height - obj.Height) / 2
End If
Next obj
' Définir le prochain appel de la macro img() après 1 seconde
If TimerActive Then
Application.OnTime Now + TimeValue("00:00:01"), "img", , True
End If
End Sub

Bonsoir,

je viens de télécharger le fichier que je vous ai communiqué et il fonctionne parfaitement !
Qu'entendez vous par il ne fonctionne pas ? Comme je vous l'ai dis, il n'est pas "automatique" car il n'y a pas de surveillance événementielle sur la modification de la largeur des colonnes, donc j'ai choisi de créer un déclanchement de code par la surveillance événementielle "Selection_Change" qui est déclenchée lorsque la cellule active est modifiée, donc après avoir modifié la taille de la colonne il faut cliquer sur une cellule autre que celle déjà active et le code se lancera. Mais il faut aussi accepter les macros

@ bientôt

LouReeD

Bonjour,

J'ai bien accepté les macro mais cependant excel les bloquent car "potentiellement dangereuse"...

Pouvez-vous me l'indiquer dans un message pour que je puisse la copier dans un fichier ?

Merci d'avance.

Bonsoir,

je vous répondrais alors deux choses :
Soit c'est la nouvelle protection d'Excel alors il vous faut faire une copie sur votre bureau (par exemple), puis de cliquer droit sur l'icône, puis propriétés et sur l'un des onglets disponible trouver la boite à cocher afin de faire de ce fichier un fichier sur.
Soit alors il faut aller dans les options d'Excel et de diminuer le niveau de sécurités des macros, au niveau où Excel vous demande l'autorisation de les mettre en marche plutôt que de les stopper sans demande.

Sinon voici ci dessous le code à mettre sur la feuille concernée (clic droit visualiser le code) :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Sheets("Feuil2").Range("A2") <> ActiveSheet.Columns(2).Width Then
        ' on met en mémoire la taille actuelle de la colonne B
        Sheets("Feuil2").Range("A2") = ActiveSheet.Columns(2).Width
        ' on centre les images de cette colonne
        For Each obj In ActiveSheet.Shapes
            If obj.Type = msoPicture Then
                Set c = obj.TopLeftCell
                ' Centrer horizontalement
                obj.Left = c.Left + (c.Width - obj.Width) / 2
            End If
        Next obj
    End If
End Sub

@ bientôt

LouReeD

Bonjour,

Cela fonctionne mais pas totalement comme je le voudrais, je vais juste mettre un bouton à cliquer pour centrer les images ce sera plus simple.

Merci pour votre investissement !!

Bonsoir,

on a déjà pas mal avancé ! Alors oui il faut changer la sélection de cellules pour que cela fonctionne... Un bouton c'est bien aussi mais cela implique de cliquer dessus et entre un clic sur un bouton et un clic sur une cellule "autre" que celle active...

En espérant que tout ceci vous ait fait avancer dans votre projet !

@ bientôt

LouReeD