Microsoft 365 Insertion Image dans une Feuille et Ratio conservé

Warlogs44

XLDnaute Nouveau
Bonjour à tous, chère experts en VBA, je suis ultra novice.

J'ai des soucis pour pour l'implantation d'image. Disons que 95% des Images de mon Document sont au format paysage et 5% au format Portrait.
Jusque là pas de problème je sais lesquels sont censés être à ce format et j'ai ajusté les tailles.

Seulement voilà parfois j'aurais des format Portrait "Non attendu" et là c"est le drame, comme j'ai défini les dimensions.

Critère 1: Je souhaitais insérer plusieurs photos bien défini à des emplacement bien précis (environ 40aine) avec un seul bouton dans mon fichier excel et sous plusieurs onglets.
Du coup je renomme mes photos avec le bon nom avant de lancer la macro.

J'ai fais le choix d'utiliser un chemin relatif car ce fichier excel est dupliqué dans chaque affaire que je traite avec son dossier photo (toujours au même nom quelque soit l'affaire). Je pensais que ça m'éviterais de devoir m'amuser à retaper le chemin dans le code pour chaque dossier. (Et un un autre collaborateur doit pouvoir utiliser le fichier). Je ne sais pas si c'était un bon choix.... vis à vis du code. (peut être qu'amener le chemin du dossier photo dans une case pourrait régler tous mes problèmes?)

Critère2: Je voulais pouvoir supprimer les photos précédentes à chaque fois qu'on appui sur le bouton d'insertion des photos. Dans le cas de modification à apporter ou un rechargement du fait d'un mauvais nom d'image.


Je n'arrive pas à intégrer simplement le .LockAspectRatio = msoTrue dans mon code, ça ne fonctionne pas.

Je risque d'avoir un autre problème ensuite comme les photos ne sont pas positionnées dans des cellules défini mais sur la feuille, c'est que celle en paysage au lieu de Portrait se mettent mal.


ce point me paraissant compliqué, j'ai voulu revoir tout le code pour insérer les photos dans des cellules, pour pouvoir les centrer et conserver le ratio, quelle soit en paysage ou en portrait mais ça ne fonctionne pas non plus.

Voici le code utilisé grâce à des Tuto, pour l'intégration d'une photo, je l'ai dupliqué pour les 40 photos avec les bonnes positions de chacune.

VB:
Sub IntegrationImage()

Sub IntegrationImage()

'Déclaration des variables
Dim chemin As String
Dim NomImage As String
Dim image As String

ThisWorkbook.Worksheets("PDG").Select

'Suppression des images précédente de la feuille
    Dim xPicRg As Range
    Dim xPic As Picture
    Dim xRg As Range
    Application.ScreenUpdating = False
    Set xRg = Range("A24:AG62")
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
    Next
    Application.ScreenUpdating = True
    
'Affectation des variables PHOTO AGENCE
chemin = ThisWorkbook.Path & "\2-Photos visite\"
NomImage = Range("D25")
image = ".jpg"

Range("D25").Value = NomImage

Sheets("PDG").Shapes.AddPicture filename:=chemin & NomImage & image, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=55, Top:=298, Width:=360, Height:=270

Si une âme sensible pouvait m'aider, peut être qu'il ne faut pas grand chose.... ou alors je dois tout revoir:eek:
 
Solution
re
Bon!!!!!!!!!!!!!!!!!!!
alors par quoi je commence ???????
alors tout d'abords comme je m'en doutais!!!!!!!!! il a probleme sur shaperange.lockaspect ration (tu aurais excel 2019 que ça m’étonnerait pas dans ton 365)

ensuite!!!!!
tu ajoute une image de la mauvaise manière avec
VB:
.Shapes.AddPicture Filename:=chemin & NomImage & Image, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=55, Top:=298, Width:=360, Height:=270
et oui la bonne blague tu la redimensionne et donc elle perd ses proportions !!!!!!!

donc fort de ces constatations je modifie un peu le truc
j'insert l'image comme tel dans la feuille avec pictures.insert EN TANT QU OBJECT PICTURE (variable(pict))
et je la replace...

patricktoulon

XLDnaute Barbatruc
Bonjour
il faut chercher un peu

un modele shape et picture
VB:
Sub PlaceThePictureInCenterRange(rng As Range, Obj As Variant, Optional PercentMarge As Long = 100)     'la marge exprime un pourcentage de 1 à x%
    Dim Ratio#, Wx#, Yx#
    Wx = rng.Cells(1).MergeArea.Width * (PercentMarge / 100)
    Yx = rng.Cells(1).MergeArea.Height * (PercentMarge / 100)
    Ratio = Application.Min(Wx / Obj.Width, Yx / Obj.Height)
    With Obj
        If TypeName(Obj) = "Shape" Then .LockAspectRatio = msoTrue Else .ShapeRange.LockAspectRatio = msoTrue
        .Width = .Width * Ratio
        .Top = rng.Top + ((rng.Cells(1).MergeArea.Height - .Height) / 2)
        .Left = rng.Left + ((rng.Cells(1).MergeArea.Width - .Width) / 2)
    End With
End Sub
 
Dernière édition:

GALOUGALOU

XLDnaute Accro
re warlogs44, bonjour patricktoulon, bonjour le forum
Je ne vais pas commenter votre code, (il n'est que partiel, et en début vous avez deux fois Sub IntegrationImage()) de plus vous n'avez pas posté un classeur ou on aurait pu vérifier la concordance du code avec sa structure).
mais dans l'ensemble la problématique que vous exposez peut (peut-être) trouver des éléments de réponse dans le classeur joint.
à partir d'un formulaire vous sélectionner des photos, qui ne sont pas affichés automatiquement au moment de la validation.
Si vous modifiez un nom ou un dossier il suffit de faire une modification à partir du formulaire.
Si vous modifiez la structure de la photo elle sera prise en compte par le bouton afficher photo.
Les photos sont visibles en totalité par le bouton afficher photo (le classeur sera purgé à la fermeture pour éviter une taille excessive)
les photos sont visibles individuellement par un clic droit dans la cellule chemin
vous devriez trouver des solutions pour développer votre projet
cdt
galougalou

 

Pièces jointes

  • formulaire userform avec photo .xlsm
    54.9 KB · Affichages: 58

Warlogs44

XLDnaute Nouveau
re warlogs44, bonjour patricktoulon, bonjour le forum
Je ne vais pas commenter votre code, (il n'est que partiel, et en début vous avez deux fois Sub IntegrationImage()) de plus vous n'avez pas posté un classeur ou on aurait pu vérifier la concordance du code avec sa structure).
mais dans l'ensemble la problématique que vous exposez peut (peut-être) trouver des éléments de réponse dans le classeur joint.
à partir d'un formulaire vous sélectionner des photos, qui ne sont pas affichés automatiquement au moment de la validation.
Si vous modifiez un nom ou un dossier il suffit de faire une modification à partir du formulaire.
Si vous modifiez la structure de la photo elle sera prise en compte par le bouton afficher photo.
Les photos sont visibles en totalité par le bouton afficher photo (le classeur sera purgé à la fermeture pour éviter une taille excessive)
les photos sont visibles individuellement par un clic droit dans la cellule chemin
vous devriez trouver des solutions pour développer votre projet
cdt
galougalou

Merci, je vais regarder et je vous dit

PS: Le double Sub c'est un double copier-coller ;)
 

Warlogs44

XLDnaute Nouveau
re warlogs44, bonjour patricktoulon, bonjour le forum
Je ne vais pas commenter votre code, (il n'est que partiel, et en début vous avez deux fois Sub IntegrationImage()) de plus vous n'avez pas posté un classeur ou on aurait pu vérifier la concordance du code avec sa structure).
mais dans l'ensemble la problématique que vous exposez peut (peut-être) trouver des éléments de réponse dans le classeur joint.
à partir d'un formulaire vous sélectionner des photos, qui ne sont pas affichés automatiquement au moment de la validation.
Si vous modifiez un nom ou un dossier il suffit de faire une modification à partir du formulaire.
Si vous modifiez la structure de la photo elle sera prise en compte par le bouton afficher photo.
Les photos sont visibles en totalité par le bouton afficher photo (le classeur sera purgé à la fermeture pour éviter une taille excessive)
les photos sont visibles individuellement par un clic droit dans la cellule chemin
vous devriez trouver des solutions pour développer votre projet
cdt
galougalou

Ci-joint le classeur
 

Pièces jointes

  • FORFAIT N°X - VPA 2021 -030521 -MACRO - TRAVAIL.xlsm
    758.9 KB · Affichages: 53

GALOUGALOU

XLDnaute Accro
re patricktoulon
Oui totalement dans un fil différent j'ai bien récupéré ta fonction qui ne me pose aucun problème à partir du formulaire.
Mais par contre je n'ai pas su la mettre en place à partir d'une macro dans un module. Je fais de l'informatique pas très souvent et à temps perdu, (mais par passion) donc je vais essayer dans le futur, de la maitriser du mieux possible pour l'intégrer à mes classeurs.
A la fermeture du classeur dans le cas ou les photos sont très nombreuses, il me semble intéressant de le purger pour éviter qu'il pèse trop lourd, et donc de les réinjecter à l'ouverture, et là je coince avec ta formule.
Dans le souci d'apporter une solution, qui n'est forcément pas la solution au vu du classeur proposé par le demandeur dans le fil 5, Je ne l'ai pas proposé dans le classeur du fil 3 par défaut de maitrise.

re warloggs44
la discussion entre membre de xld ne nous détourne pas de la motivation que nous avons à vous aider, mais pour l'instant en ce qui me concerne, je n'ai pas de proposition sur votre classeur
cdt
galougalou
 

patricktoulon

XLDnaute Barbatruc
re
la tu m'étonne cette sub va aussi bien dans un module qu'un userform
Du coup j'ai même amélioré la location Range pour les fusions
on peut injecter soit une cell soit un range
la sub teste si la cell fait partie d'une fusion et réajuste toute seule
ci joint un userform et injection dans la range sur la feuille
 

Pièces jointes

  • Sample- PUT AN IMAGE AT THE CENTER OF RANGE patricktoulon france.xlsm
    22.5 KB · Affichages: 60

Warlogs44

XLDnaute Nouveau
A la fermeture du classeur dans le cas ou les photos sont très nombreuses, il me semble intéressant de le purger pour éviter qu'il pèse trop lourd, et donc de les réinjecter à l'ouverture, et là je coince avec ta formule.
Dans le souci d'apporter une solution, qui n'est forcément pas la solution au vu du classeur proposé par le demandeur dans le fil 5, Je ne l'ai pas proposé dans le classeur du fil 3 par défaut de maitrise.

re warloggs44
la discussion entre membre de xld ne nous détourne pas de la motivation que nous avons à vous aider, mais pour l'instant en ce qui me concerne, je n'ai pas de proposition sur votre classeur
cdt
galougalou
Merci tout de même pour ton aide,

Cette macro est vouée à faciliter le remplissage du document par un technicien pour ensuite l'envoyer au client bien rempli.

Il n'est pas souhaitable de le purger ou à recharger les photos à chaque ouverture. Les photos sont bien liées une fois insérées.
 

Warlogs44

XLDnaute Nouveau
Bonjour
il faut chercher un peu

un modele shape et picture
VB:
Sub PlaceThePictureInCenterRange(rng As Range, Obj As Variant, Optional PercentMarge As Long = 100)     'la marge exprime un pourcentage de 1 à x%
    Dim Ratio#, Wx#, Yx#
    Wx = rng.Cells(1).MergeArea.Width * (PercentMarge / 100)
    Yx = rng.Cells(1).MergeArea.Height * (PercentMarge / 100)
    Ratio = Application.Min(Wx / Obj.Width, Yx / Obj.Height)
    With Obj
        If TypeName(Obj) = "Shape" Then .LockAspectRatio = msoTrue Else .ShapeRange.LockAspectRatio = msoTrue
        .Width = .Width * Ratio
        .Top = rng.Top + ((rng.Cells(1).MergeArea.Height - .Height) / 2)
        .Left = rng.Left + ((rng.Cells(1).MergeArea.Width - .Width) / 2)
    End With
End Sub
Bonjour,

Le lien du sujet TuTO que vous avez joint est vraimment bien, c'est tout à fait ça, mais ça ne fonctionne pas dans mon classeur et je n'ai pas encore trouvé pourquoi.
 

Warlogs44

XLDnaute Nouveau
re
la tu m'étonne cette sub va aussi bien dans un module qu'un userform
Du coup j'ai même amélioré la location Range pour les fusions
on peut injecter soit une cell soit un range
la sub teste si la cell fait partie d'une fusion et réajuste toute seule
ci joint un userform et injection dans la range sur la feuille
Bonjour, J'ai testé, ce n'est pas concluant sur ma version 365 en tout cas.
 

Pièces jointes

  • Capture.PNG
    Capture.PNG
    134.6 KB · Affichages: 33

patricktoulon

XLDnaute Barbatruc
Bonjour
déjà testé sur 365 et ça fonctionne ,le problème est ailleurs

et de toute façon c'est un simple calcul du min d'un coté ou de l'autre quelque soit la version d'excel 1 sera toujours plus petit que 2
regarde du coté des protections ou je ne sais quoi sur ta feuille
le principe de ma fonction

ratioWidth= width de la plage /width de l'image
ratioheight= height de la plage/height de l'image
le ratio que l'on garde c'est le plus petit
donc on divise le width ou le height de l'image (tout en mettant le lockaspectratio) par ce ratio minimum

et qu'importe que l'image soit plus grande ou plus petite que la plage au départ ça marche dans les deux sens

et on la place avec les dimensions obtenues

ça c'est universel 🤣

envoie moi cette photo pour voir
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
demo
demo7.gif
 

Warlogs44

XLDnaute Nouveau
Re,

Sachant que j'ai télécharger votre classeur, je vois pas où ça peut coincer.

Ci-joint une photo.

ça fonctionne sur mes photos qui sont en paysage, mais pas lorsqu'elle sont en portrait.

C'est ce qui m’ennuie aussi sur mon classeur.

lorsque vous créer un dossier "2-Photos visite" dans le même dossier que le classeur.

> à l'intérieur de ce dossier vous mettez des photos d'un format original portrait et paysage
nommés:
E21
E22
E23

>vous pourrez voir sur l'onglet E2 ce qu'il se passe.
 

Pièces jointes

  • AGTEST.JPG
    AGTEST.JPG
    488.3 KB · Affichages: 31
Dernière édition:

GALOUGALOU

XLDnaute Accro
re patrick toulon
Ça y est eurêka, avec le classeur que tu as posté sur ce fil, j'ai réussi à intégrer ta 'fonction perso patricktoulon dans mes modules. Maintenant c'est fonctionnel

re warlogs44
Je dois avouer que je n'interprète pas votre problème avec la photo que vous postez sur le fil 14.
Je crois comprendre qu'elle apparait à l'envers, si tel est le cas, la raison vient du fait qu'elle a été tourné dans le dossier d'origine. Pourriez vous précisez svp.

Si tel est le cas une solution, vous ouvrez la photo avec "photo filtre", vous "enregistrez sous" la photo orientée comme vous le souhaitez, et dans la boite de dialogue qui suivra, vous décochez garder les données exif. l'orientation images disparaitra des données exif de la nouvelle photo, et de la sorte la photo s'inscrira parfaitement dans la cellule de destination. Tous les logiciels photo qui suppriment le tag d'orientation ferons l'affaire.

En plus les données exif contiennent des informations confidentielles, et vous nous dites dans le message que vous envoyez les photos à des clients, il est peut-être souhaitable de supprimer toutes les données exif avant de les inclure dans le classeur, afin de ne pas partager des données confidentielles
cdt
galougalou
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 046
Messages
2 084 848
Membres
102 686
dernier inscrit
Franck6950