redimensionner une photo sur plusieurs cellules fusionnées

  • Initiateur de la discussion Initiateur de la discussion Mastertrack
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Mastertrack

XLDnaute Nouveau
Bonjour,
J'ai dans mon excel une userform avec liste déroulante de produits, je choisis mon produit et sa fiche apparaît ainsi que sa photo. Le problème étant que la photo apparaît dans une cellule et est trop petite. J'aimerais la faire apparaître dans les cellules A4-C7 qui sont fusionnées mais impossible...
J'ai essayé, d'après les autres discussions du forum de fonctionner avec .Left / .Right etc... mais ça ne fonctionne pas. A savoir que la macro fait appel à une cellule (cheminphoto) dans laquelle il y a une RECHERCHEV qui fait appel à la photo correspondante au produit se trouvant sur mon disque dur. Je vous joins le code ainsi qu'une photo du fichier pour donner un aperçu, merci de votre aide !

Windows("parametres_process_u7.xlsm").Activate
Sheets("Fiche par produit").Select
If ActiveSheet.Pictures.Count > 0 Then
Dim machaine As String
For Each maphoto In ActiveSheet.Shapes
machaine = maphoto.Name

Next
ActiveSheet.Shapes(machaine).Select
Selection.Delete
End If
Application.Goto Reference:="R4C1"
Dim cheminphoto As String
cheminphoto = ActiveCell.Value
ActiveSheet.Pictures.Insert(cheminphoto).Select
 

Pièces jointes

  • excel1.PNG
    excel1.PNG
    93.4 KB · Affichages: 15
Dernière édition:
Bonjour Mastertrack, bienvenue sur XLD,

D'après votre code on comprend que le chemin d'accès de la photo est dans la cellule A4, alors utilisez :
VB:
Sub InsertImage()
Dim o As Object
With Workbooks("parametres_process_u7.xlsm").Sheets("Fiche par produit")
    If Dir(CStr(.[A4])) = "" Then MsgBox "Le chemin d'accès en A4 n'est pas correct...": Exit Sub
    Application.ScreenUpdating = False
    .DrawingObjects.Delete 'RAZ
    Set o = .Pictures.Insert(CStr(.[A4]))
    o.ShapeRange.LockAspectRatio = msoTrue 'fige le rapport hauteur/largeur
    With .[A4:C7]
        '---dimensionnement---
        o.Width = .Width
        If o.Height > .Height Then o.Height = .Height
        '---centrage---
        o.Top = .Top + (.Height - o.Height) / 2
        o.Left = .Left + (.Width - o.Width) / 2
    End With
End With
End Sub
A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
22
Affichages
3 K
  • Question Question
Microsoft 365 choisir une page
Réponses
6
Affichages
806
Réponses
0
Affichages
811
Retour