Centrer une image dans une Zone "Range"
Bonjour,
Je reviens avec une problématique.
Je souhaite insérer une image dans ma feuille Excel.
Ne connaissant pas la taille de l'image, je souhaite la "formater"
Pour ce faire j'ai créer une Zone ici "Range("J2:M6")"
j'active cette zone, puis insère mon image, en gardant l'aspect ratio
je la resize pour rentrer dans ce cadre
Mais là... problème l'image se resize sans problème mais reste en haut de la zone.
Ne connaissant pas les tailles, et le ratio des images, je souhaiterais garder le resize
mais aussi le centrer dans la zone
Voilà le code que j'ai utilisé.....
Range("J2:M6").Select
ActiveSheet.Range("J2:M6").BorderAround Color:=RGB(255, 0, 0), Weight:=xlThick
'import de l'image à partir du repertoire de stockage
'rendre le lien vers la zone de stockage parametrable dans le futur (Une page type INI)
ActiveSheet.Pictures.Insert("C:\Users\nounours\Desktop\BD\Images\Entete\21303.png").Select
selection.ShapeRange.LockAspectRatio = msoTrue 'Vérouiller l'apect ratio
'Etirer/reduire et centrer image selon "Hauteur" de la zone
selection.ShapeRange.Height = Range("J2:M6").Height
'Etirer/reduire et centrer image selon "Largeur" de la zone
selection.ShapeRange.Width = Range("J2:M6").WidthEn vous remerciant d'avance
Bonsoir,
Pour centrer l'image dans ta plage, soit : Hpl valeur Height de la plage, h valeur Height de l'image, Wpl valeur Width de la plage, w valeur Width de l'image, Lpl valeur Left de la plage, Tpl valeur Top de l'image.
Pour positionner l'image on définit ses valeurs Left et Top :
Left = Lpl + (Wpl - w)/2
Top = Tpl + (Hpl - h)/2
Cordialement.
Bonjour Mferrand,
Je n'ai pas très bien saisi ton idée...
Pour le moment, je n'arrive qu'à adapter la largeur de l'image à la zone défini, ou la hauteur à la zone défini, en gardant l'aspect ratio
d'origine de l'image source.
En furetant pour des infos, je suis tombé sur ce site
http://boisgontierjacques.free.fr/pages_site/lesimages.htm
Il y explique pas mal de chose^intéressante... j'ai essayé ses manip, et nop .. j'y arrive pas ^^
Mais je vais pas laisser tomber.....
A+
Bonjour le forum,
Après de multiples essais, j'ai trouvé la solution... pointé vers la bonne direction par Mferrand...
puis aussi trouvé un sujet sur le forum, avec une méthode
Voici le code que j'ai fait
Sheets(Nom).Activate
Set Sh = ActiveSheet.Shapes(Nom)
With Range("J2:M6")
Sh.Left = .Left + (.Width / 2) - (Sh.Width / 2)
Sh.Top = .Top + (.Height / 2) - (Sh.Height / 2)
End WithMerci pour l'aide
Nounours
Pour centrer ton image, c'est un calcul de coordonnées assez simple, ainsi que je te l'ai indiqué.
Dans Excel les coordonnées se définissent par les propriétés Left et Top, distances en points entre l'objet et respectivement le bord droit et le bord haut de la fenêtre de l'application.
Les objets ont également des dimensions définies par les propriétés Width et Height, largeur et hauteur, également en points.
Une plage de cellules est un objet, tu peux donc affecter les 4 propriétés qui définissent la taille et la position de cette plage à des variables.
L'image est aussi un objet, tu peux faire de même en affectant les propriétés qui définissent sa taille à des variables.
Muni de ces 6 valeurs tu peux donc calculer les coordonnées de l'image pour qu'elle soit centrée dans la plage...
Mais tu peux poursuivre avec Boisgontier, c'est une source particulièrement fiable.
Cordialement.
Bravo !
Maintenant tu peux reprendre ta macro initiale : affecter dès le départ ton image à une variable objet lors de l'insertion, et supprimer tous tes Select encombrant, et autres expressions utilisant inutilement ShapeRange... Ta variable suffit pour tout faire.
Bonjour au forum,
J'étais assez content de ma routine elle fonctionnait, mais que dans certain cas... c'était balo
Le but de cette routine étant de gérer des image "png" venant de tout horizon, et qui ont de diverses tailles
Donc lors de mes test j'avais une image de 301x168 et effectivement cela fonctionnait très bien, puis j'ai testé avec
une autre de 384x288 ... là aussi tout allait bien... hourra je suis le meilleur que je croyais .... loool
Mais avec la dernière qui elle faisait 1200*1031, rien n'allait plus, la largeur restait bien dans les clou, mais pas la
hauteur, elle dépassait le cadre réservé. tout en ayant la largeur du cadre
Je croyais gérer la hauteur et la largeur en même temps et donc que la routine forcait le tout de rentrer.
en respectant le Ratio, tant que Hauteur et largeur étaient toutes deux dans le gabarit. qui lui fait en pixel Excel 416*330
Voici le code concerné par la gestion de l'image
Entete = "C:\Users\nounours\Desktop\BD\Images\Entete\" 'Chemin image entete
Nom = "10143" 'Nom du fichier/set/image entete/onglet
'mise en place de la zone de Calibration de l'image
Set zone = Range("J2:M6") 'Donne un nom à la zone des limites
With zone 'Determine la zone des limites
.MergeCells = True 'Fusionner les cellules
.BorderAround Color:=RGB(255, 0, 0), Weight:=xlThick
.Font.Name = "Calibri" 'choix de la police
.Font.Size = 26 'Taille de la police
.Font.Bold = True 'Police en gras
.WrapText = True 'renvoi à la ligne automatiquement
.HorizontalAlignment = xlCenter 'Centrer texte horizontalement
.VerticalAlignment = xlCenter 'Centrer texte verticalement
.Value = "ZONE CALIBRAGE PHOTO" 'Ecrire texte dans cellule
End With
'import de l'image à partir du repertoire de stockage
'rendre le lien vers la zone de stockage parametrable dans le futur (Une page type INI)
zone.Select
With ActiveSheet
.Pictures.Insert(Entete & Nom & ".png").Name = Nom 'insérer image puis nommer la shape dans la feuille excel
.Shapes(Nom).LockAspectRatio = msoTrue 'Vérouiller l'aspect ratio
.Shapes(Nom).Height = zone.Height 'Adapter image selon "Hauteur" de la zone
.Shapes(Nom).Width = zone.Width 'Adapter image selon "Largeur" de la zone
'.Shapes(Nom).ScaleWidth 0.99, msoFalse, msoScaleFromTopLeft 'scale down largeur afin de voir les bordures
'.Shapes(Nom).ScaleHeight 0.99, msoFalse, msoScaleFromTopLeft 'scale down height afin de voir les bordures
End With
Set SH = ActiveSheet.Shapes(Nom) 'done nom cours pour instrution
With zone 'Determine la zone des limites
SH.Left = .Left + (.Width / 2) - (SH.Width / 2) 'Centre l'image sur la largeur de la zone
SH.Top = .Top + (.Height / 2) - (SH.Height / 2) 'Centre l'image sur la hauteur de la zone
End WithSi je désactive la ligne ".Shapes(Nom).Width = zone.Width ", mon image à problème s'adaptait parfaitement en hauteur, et la largeur était à l'intérieur avec de la marge. Ce que je souhaitais au final.
Mais maintenant les images qui elles fonctionnaient avant, débordaient des limites en largeur.
Donc comment puis je faire, pour mettre en place une condition qui dit si hauteur image = hauteur de zone, mais si Largeur image > largeur de zone faire ligne suivante .Shapes(Nom).Width = zone.Width
Et c'est en écrivant ce post que "Tilt" J'ai eu une idée lumineuse ^^ .... comme quoi cela sert d'écrire les choses MDR
Une condition if / then / else, qui après la mise en conformité de la hauteur de l'image, tout en respectant l'aspect ratio vérifie
si la largeur de l'image est supérieur à celle du cadre. Si oui, elle adapte donc la largeur de l'image tout en respectant l'aspect ratio ....
et cela donne le codage suivant ....
'mise en place de la zone de Calibration de l'image
Entete = "C:\Users\nounours\Desktop\BD\Images\Entete\" 'Chemin image entete
'(lien vers la zone de stockage paramétrable dans le futur (Une page type INI))
Nom = "10143" 'Nom du fichier/set/image entete/onglet
'sera dynamique dans le futur, récupérer sur autre
Set zone = Range("J2:M6") 'Donne un nom à la zone des limites
With zone 'Determine la zone des limites
.MergeCells = True 'Fusionner les cellules
.BorderAround Color:=RGB(255, 0, 0), Weight:=xlThick
.Font.Name = "Calibri" 'choix de la police
.Font.Size = 26 'Taille de la police
.Font.Bold = True 'Police en gras
.WrapText = True 'renvoi à la ligne automatiquement
.HorizontalAlignment = xlCenter 'Centrer texte horizontalement
.VerticalAlignment = xlCenter 'Centrer texte verticalement
.Value = "ZONE CALIBRAGE PHOTO" 'Ecrire texte dans cellule
End With
'import de l'image à partir du repertoire de stockage
zone.Select
With ActiveSheet
.Pictures.Insert(Entete & Nom & ".png").Name = Nom 'insérer image puis nommer la shape dans la feuille excel
.Shapes(Nom).LockAspectRatio = msoTrue 'Vérouiller l'aspect ratio
.Shapes(Nom).Height = zone.Height 'Adapter image selon "Hauteur" de la zone
End With
Set SH = ActiveSheet.Shapes(Nom) 'Donne nom cours pour instrution
If SH.Width > zone.Width Then 'tester largeur image pas supérieur à la "Largeur" de la zone
SH.Width = zone.Width 'Adapter image selon "Largeur" de la zone
End If
With ActiveSheet
.Shapes(Nom).ScaleWidth 0.99, msoFalse, msoScaleFromTopLeft 'scale down largeur afin de voir les bordures
.Shapes(Nom).ScaleHeight 0.99, msoFalse, msoScaleFromTopLeft 'scale down height afin de voir les bordures
End With
With zone 'Determine la zone des limites
SH.Left = .Left + (.Width / 2) - (SH.Width / 2) 'Centre l'image sur la largeur de la zone
SH.Top = .Top + (.Height / 2) - (SH.Height / 2) 'Centre l'image sur la hauteur de la zone
End WithEnfin je suis content ^^ quoique ...
Est ce que quelqu'un peux m'expliquer pourquoi si je met la ligne Set SH = ActiveSheet.Shapes(Nom), au début de mon code
pourquoi j'ai une erreur disant : erreur d'exécution -'2147024809 (80070057)' "l'élément portant ce nom est introuvable"
Je ne maitrise pas ces variables, et déclarations, doit avoir un truc avec ^^
Désolé pour le mega long post ...
Merci, de l'aide que vous pourrez m'apporter sur le message d'erreur, et les conseils pour améliorer le code
bonsoir
Tout simplement pcq le variable "Nom" n est pas encore initialise, Si est de type "string" il va vous donnezune une chaine de longueur nulle ==> "" ,si vous mettez la ligne Set SH = ActiveSheet.Shapes(Nom), au début de code, il va chercher l’objet qui peut porte le nom "" et comme ca vous auriez l erreur pcq "l'élément portant ce nom est introuvable" et vous n’avez pas surement un Shape portant le nom "" =>> nulle
Bonjour AMIR....
mais oui bien sûr.....
il faut que
SH = ActiveSheet.Shapes(Nom) soit mis en place après que "
shape (nom) soit créée ....
et cela se fait 3 lignes au dessus.... et non pas au début ^^
merci Amir