Insertion image à la taille d'une cellule
Bonsoir le forum et bonne année!
J'aimerai savoir si il était possible de créer une macro qui permette, lors de l'insertion d'une image, que cette même image s'adapte à la taille de la cellule (ou les cellules fusionnées) dans laquelle on l'insère. Cela me permettrait de gagner un temps fou... J'ai cru vois cela:
Sub insere_image_ratio()
Dim ficimg As String, Ad As String
Dim MemW As Long, MemH As Long, T As Integer, L As Integer
Dim Lg As Integer, HT As Integer, RatioCell As Single
Dim CellH As Long, CellW As Long, RatioHz As Single, RatioVt As Single
Ad = Selection.Address
CellH = Selection.Height
CellW = Selection.Width
ficimg = Application.GetOpenFilename(".jpg,*.jpg,.gif,*.gif,.jpeg,*.jpeg", , "Choisissez l'image") ' choix nom du fichier
If ficimg = "Faux" Then Exit Sub
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
MemW = .Width: MemH = .Height
'adapte les ratio
If MemH < CellH And MemW < CellW Then
'l'image < cellule
RatioHz = MemH / CellH
RatioVt = MemW / CellW
If RatioVt < RatioHz Then 'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
Else 'adapter en largeur
Lg = CellW: HT = MemH * (CellW / MemW)
L = 0: T = (CellH - HT) / 2
End If
ElseIf MemH > CellH And MemW > CellW Then
'l'image > cellule
RatioHz = CellH / MemH
RatioVt = CellW / MemW
If RatioVt > RatioHz Then 'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
Else 'adapter en largeur
Lg = CellW: HT = MemH * (Lg / MemW)
L = 0: T = (CellH - HT) / 2
End If
ElseIf MemH > CellH And MemW < CellW Then
'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
ElseIf MemH < CellH And MemW > CellW Then
'adapter en largeur
Lg = CellW: HT = MemH * (Lg / MemW)
L = 0: T = (CellH - HT) / 2
Else
Stop ' pas prévu ?
End If
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = Range(Ad).Top + T ' haut de la cellule
.Left = Range(Ad).Left + L ' gauche de la cellule
.Height = HT
.Width = Lg ' largeur des cellules fusionnées
End With
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
End Sub
Mais je ne sais pas trop si cela convient à ma demande ni l'utiliser! Voila, j'espère obtenir un coup de pouce et encore merci!
Hello,
Chez moi, elle marche nickel ta macro.
Pour l'utiliser, rends toi dans l'onglet Développeur d'Excel. S'il n'apparait pas dans le Ruban, clique droit sur celui-ci et "Personnaliser le Ruban". Ajoutes l'onglet développeur.
Clique sur "Insertion", "Bouton", et dessine un bouton avec ta souris.
Une fois le bouton apparu, renomme-le si besoin et clique droit sur celui-ci : tu choisis "Affecter une macro".
Va s'ouvrir une fenêtre où tu pourras sélectionner ta macro, clique sur "nouvelle" et une autre fenêtre va s'ouvrir où tu verras "Sub ****" et "End sub" en bas.
Supprime le tout, et colle la totalité du code que tu viens de fournir.
Quitte la fenêtre, et réaffecte la macro (celle-ci ayant changé de nom dans le processus).
Clique sur le bouton, une fenêtre s'ouvrira et te proposera de choisir l'image à insérer.
Enjoy
Bonjour!
Je CROIS avoir compris le principe, je clic sur le bouton (avec macro affectée), ce qui m'insère une image MAIS le problème étant que l'image sera insérée sur la feuille ou le bouton est et non pas forcément sur la feuille ou je veux y mettre mon image... Je me vois mal rajouter ce bouton sur toutes mes feuilles juste pour une manipulation (car l'image par la suite ne changera plus...). Sauf si c'est moi qui ne sais pas m'en servir...
N'y aurait-il pas plutôt une macro qui me permettrait de définir la taille "par défaut" d'une image lorsqu'elle est insérée? Si elle est plus grande que la taille par défaut alors elle se réduit toute seule et si elle est plus petite elle s'agrandit toute seule. Étant donné que mes cellules fusionnées ou j'insère mes images sont TOUTES de la même taille, ça serait une solution...
Pour la première demande, je te fais ça ce soir (je suis pas sur mon pc).
Pour la seconde, tu t'y retrouves avec la macro actuelle, car elle redimensionne automatiquement aux dimensions de ta cellule. Donc si tu insères dans la cellule fusionnée, elle sera rétrécie si trop grande, agrandie si trop petite.
Disons qu'elle fait l'affaire en permettant plus de souplesse des fois que tes dimensions prédéfinies changent.
Je comprend bien la chose! La macro m'irait parfaitement si celle-ci permettait l'insertion n'importe ou plutôt que dans la feuille ou le bouton (déclencheur de la macro) se situe...
Voilà, sans fichier c'est le mieux que je puisse faire.
Si tu fournis le fichier, on pourrait partir sur un userform qui permettrait de sélectionner la feuille dans une liste, plutôt que d'en taper le nom.
Là, tu saisis d'abord la feuille, puis tu sélectionnes la cellule désirée à la souris.
Si tu lances toujours la macro depuis la même feuille, créé un bouton ; sinon, utiliser l'onglet développeur dans le ruban, clique sur macro, sélectionne "insere_image_ratio" puis "Exécuter"
Sub insere_image_ratio()
Dim ficimg As String, Ad
Dim MemW As Long, MemH As Long, T As Integer, L As Integer
Dim Lg As Integer, HT As Integer, RatioCell As Single
Dim CellH As Long, CellW As Long, RatioHz As Single, RatioVt As Single
Dim ws
ws = InputBox("Saisissez le nom de la feuille dans laquelle vous souhaitez insérer l'image")
Worksheets(ws).Activate
Set Ad = Application.InputBox("Sélectionnez une plage à laquelle vous souhaitez insérer l'image !", "Sélection de la cellule", Type:=8)
Ad.Select
Ad = Selection.Address
CellH = Selection.Height
CellW = Selection.Width
ficimg = Application.GetOpenFilename(".jpg,*.jpg,.gif,*.gif,.jpeg,*.jpeg", , "Choisissez l'image") ' choix nom du fichier
If ficimg = "Faux" Then Exit Sub
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
MemW = .Width: MemH = .Height
'adapte les ratio
If MemH < CellH And MemW < CellW Then
'l'image < cellule
RatioHz = MemH / CellH
RatioVt = MemW / CellW
If RatioVt < RatioHz Then 'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
Else 'adapter en largeur
Lg = CellW: HT = MemH * (CellW / MemW)
L = 0: T = (CellH - HT) / 2
End If
ElseIf MemH > CellH And MemW > CellW Then
'l'image > cellule
RatioHz = CellH / MemH
RatioVt = CellW / MemW
If RatioVt > RatioHz Then 'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
Else 'adapter en largeur
Lg = CellW: HT = MemH * (Lg / MemW)
L = 0: T = (CellH - HT) / 2
End If
ElseIf MemH > CellH And MemW < CellW Then
'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
ElseIf MemH < CellH And MemW > CellW Then
'adapter en largeur
Lg = CellW: HT = MemH * (Lg / MemW)
L = 0: T = (CellH - HT) / 2
Else
Stop ' pas prévu ?
End If
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = Range(Ad).Top + T ' haut de la cellule
.Left = Range(Ad).Left + L ' gauche de la cellule
.Height = HT
.Width = Lg ' largeur des cellules fusionnées
End With
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
End SubBonjour!
Partons plutôt sur la userform je pense que cela sera plus facile. Si jamais ce n'est pas le cas j'aviserai en demandant si des changements sont possible!
Voici un fichier test!
L'image doit s'insérer dans les cellules fusionnées (fond blanc) et se dimensionner automatiquement à cette taille.
J'aimerai que la userform soit intégrée DANS le classeur et non pas ouvrir une mini fenêtre indépendante si possible.
Après test je verrai si la chose est pratique ou non pour mon utilisation.
En tout cas merci pour tes réponses et à très vite!
Bonsoir,
Désolé j'étais en pleine période de partiels. Je regarde ça dans la soirée
Essaie le fichier joint
Bonsoir! J'ai vu que tu avais créé une userform mais celle-ci ne s'ouvre pas à l'ouverture du fichier...
Merci d'avance et bonne chance pour tes partiels
Ah ! C'était volontaire, ça risque de t’embêter au bout d'un moment.
Quoi qu'il en soit dans le fichier joint à ce post, l'userform se lance dès l'ouverture.
Et merci
En jetant un oeil au fichier, je suis tombé sur ton code "sub_avancer_click" "sub_reculer_click"
Remplace le par celui-ci si tu veux éviter le crash quand il n'y a pas de feuille avant/après l'active
Sub Avancer_Cliquer()
Worksheets(ActiveSheet.Index - Not ActiveSheet.Index + 1 > Worksheets.Count).Select
End Sub
Sub Retour_Cliquer()
Worksheets(ActiveSheet.Index + Not ActiveSheet.Index - 1 < 1).Select
End SubMerci pour le conseil pour les flèches même si je n'ai jamais eu de problème car sur ma première feuille je n'ai pas de flèche "Précédent" et sur la dernière pas de "Suivant" donc pas de problème de débogage, c'est uniquement sur le fichier test
Pour ce qui est de la Userform on rentre dans ce que je ne voulais pas malheureusement, cela ouvre une mini fenêtre "extérieur" au classeur... De plus ce n'est pas très fonctionnel, j'aurai préféré une méthode plus efficace et rapide car la je doit choisir une feuille dans la liste déroulante (sachant que sur mon fichier réel j'en ai plus de 700...), ensuite indiqué manuellement la cellule ou insérer l'image et ensuite choisir l'image... Je vais bien plus vite en insérant l'image dans ma cellule et en la réduisant manuellement pour qu'elle rentre dans ma cellule pile poil.
Serait-il possible de faire en sorte que TOUTE les images insérés dans mon classeur aient la même taille? Les seules images que j'insère dans celui-ci sont les images dans le descriptif de mes séries et elles sont TOUTES à la même taille. Si elle font toute la même taille et bien elle rentreront pile poil dans ma cellule sans avoir à les redimensionner! Tu m'avais dis que sa poserais problème si par la suite je veux insérer des images plus grande mais pour le moment ce n'est pas le cas (et je ne pense pas que ce le sera à l'avenir) donc si tu as possibilité de m'aider à faire une chose du genre je pense que mon problème serait résolu...
Merci quand même de l'aide apportée via cette userform qui malheureusement ne correspond pas à mes besoins
Pour la sélection de la cellule, j'avais pas pensé mais du coup vu que c'est toujours la même, pas besoin de la sélectionner.
Par contre, je ne vois pas comment faire pour chercher "facilement" dans une liste de 700 éléments...là je sèche.
Pour la dimension de l'image, ça peut se faire facilement mais j'ai peur que l'image se déforme si on l'étire en longueur.
En tout cas le problème reste la sélection des feuilles qui ne te convient pas, je n'ai pas d'autres idées, très honnêtement. Du coup, si quelqu'un en trouve une, je veux bien te modifier les deux autres points, mais sinon ça ne vaut pas la peine.
Pour ce qui est de l'étirement n'ai pas peur quand je sélectionne des images je fait en sorte de les prendre au format portrait (donc dans le même sens que ma cellule) et assez grand pour qu'elle soit rétrécie et non pas étirée
Si tu peux me faire la solution que je demande ça me va après pour modifier ce que tu m'a montré... J'avoue que je ne sais pas, rien que le fait que se soit une mini fenêtre extérieur a mon classeur me gène.
OK pour l'étirement.
Au mieux je pourrais te mettre une combobox ancrée dans une feuille, mais ça ne résoudra pas le problème de la sélection difficile due au nombre de feuilles
La je sent que tu continues à te triturer les méninges sur la première solution que tu m'a montré.
On oublie la sélection de feuille et compagnie, faisons simple du moins fais simple. Juste quelques lignes qui permettent de mettre les images insérées (n'importe ou dans le classeur) à une taille prédéfinie (par exemple: 800*600)...
Exemple:
J'appuie sur insertion>image OU à la rigueur pour gagner du temps peut être un bouton qui permet de déclencher l'insertion plutôt que d'aller dans le ruban et faire Insertion > Image, bouton que je mettrai sur toutes mes feuilles descriptif.
Je sélectionne mon image et quand elle sera insérée elle se mettra toute seule au format 800*600.
Pas de sélection de page (car de toute manière j'insère une image lorsque je créer la feuille descriptif tout en y renseignant le synopsis et compagnie... donc je serai déjà sur la page) et pour ce qui est de la cellule je sélectionnerai manuellement la cellule blanche ou insérer l'image (comme je fais d'habitude) et comme l'image sera à la taille de la cellule grâce au code et bien elle entrera pile poil dedans
Oublie donc la userform
EDIT: cette solution ou alors j'ai une autre idée qui mènerai au même résultat (si faisable).
En gros une taille d'image en fonction de l'endroit ou est inséré l'image.
Si elle est inséré en C6 (ma cellule fusionnée) et bien alors l'image sera en 800*600 si c'est autre part bin elle aura la taille qu'elle devrait avoir (si l'image que j'ai prise est en 500*500 elle s'insérera en 500*500 si je l'insère autre part qu'en C6)...
Aller, on repart pour un tour... Essaie ça
(Modifie ficimg.Height par celle que tu veux, dans l'éventualité où la photo n'est pas insérée dans l'activecell C6)
Bonjour!
D'accord je vois comment cela fonctionne et ça me parait pas mal!
Une seule chose! J'ai dis plus tôt que l'étirement importait peu... En fait je vais me contredire...
Est-il possible d'ajouter dans ce que tu m'a donné une fonction d'étirement si l'image est plus petite que la cellule?
Même si elle est plus grande d'ailleurs! Car lors du rétrécissement si je ne me trompe pas elle se rétrécie pour rentrer dans la cellule mais garde sont ratio pour ne pas déformer l'image MAIS si jamais l'image sélectionnée n'est pas au format portrait exactement proportionnel à ma cellule il reste des blanc sur les côtés (en haut/bas ou à gauche/droite)...
Le mieux c'est de te montrer pour ce que tu vois ce que je veux dire! Ci-joint une image qui me pause problème.
Insère la avec la macro que tu m'a donné et tu verra qu'il y a des blancs en haut et en bas.
En gros pour ce cas il faudrait bien rétrécir l'image en largeur mais l'étirer en longueur (cela ne déformerai pas énormément l'image... donc peu m'importe)... Il faudrait que la même chose soit faisable inversement (rétrécir en hauteur et étirer en largeur).
Voila c'est le seul hic que j'ai trouvé sinon le reste me va! Merci encore pour ton dur labeur
