XL 2010 Afficher image (réduction taille proportionnelle)

Créer une discussion
Répondre

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 !

S'inscrire
cathodique

cathodique

XLDnaute Barbatruc
Bonjour,

je reviens avec une autre problématique. J'ai bien cherché mais je pense que je suis un piètre fouineur.
Je voudrais afficher des images dans une plage définie (coloriée) ou une shapes (en K1) tout en gardant les proportionnalités.

j'ai pas trouvé l'équivalent de la propriété PictureSiseMode =1-fmPictureSizeModeStretch comme pour le contrôle Image des userforms.

J'utilise ce code mais les images ne s'adaptent pas à la plage (ou shapes que je n'ai pas mis).
VB: 
Option Explicit

Sub InsertImage()

   Dim ws As Worksheet
   Dim imagePath As String
   Dim imgLeft As Double
   Dim imgTop As Double

   Set ws = Feuil1
   imagePath = ThisWorkbook.Path & "\photos\" & [C4].Text & ".jpg"
   imgLeft = ws.[k1].Left
   imgTop = ws.[k1].Top

   ws.Shapes.AddPicture _
         Filename:=imagePath, _
         LinkToFile:=msoFalse, _
         SaveWithDocument:=msoTrue, _
         Left:=imgLeft, _
         Top:=imgTop, _
         Width:=-1, _
         Height:=-1

End Sub
je joins quelques images qui n'ont pas les mêmes dimensions.

En vous remerciant.

Bonne journée
 

Pièces jointes

Solution
piga25
Re
Pour supprimer l'image existante avant :
VB: 
Sub InsertImage()

   Dim ws As Worksheet
   Dim imagePath As String
   Dim image As Picture
   Dim imageRange As Range
   Dim pic As Picture
  
'définition de la feuille et de la plage
   Set ws = Feuil1
   Set imageRange = ws.Range("K1:L7")
' Supprimez les images existantes dans la plage spécifiée
   For Each pic In ws.Pictures
        If Not Intersect(pic.TopLeftCell, imageRange) Is Nothing Or _
           Not Intersect(pic.BottomRightCell, imageRange) Is Nothing Then
            pic.Delete
        End If
    Next pic
' Chemin du fichier image
   imagePath = ThisWorkbook.Path & "\photos\" & [C4].Text & ".jpg"
' Insérez l'image dans la feuille
   Set image = ws.Pictures.Insert(imagePath)...
Trier par date Trier par votes
Bonjour,
Peut-être comme cela:
VB: 
Sub InsertImage()

   Dim ws As Worksheet
   Dim imagePath As String
   Dim image As Picture
   Dim imageRange As Range
'définition de la feuille et de la plage
   Set ws = Feuil1
   Set imageRange = ws.Range("K1:L7")
' Chemin du fichier image
   imagePath = ThisWorkbook.Path & "\photos\" & [C4].Text & ".jpg"
' Insérez l'image dans la feuille
   Set image = ws.Pictures.Insert(imagePath)
' Ajustez les dimensions de l'image à la plage spécifiée
   With image
        .Top = imageRange.Top
        .Left = imageRange.Left
        .Width = imageRange.Width
        .Height = imageRange.Height
   End With
  
End Sub
 
Vote positif 0 Vote négatif
piga25 à dit:
Bonjour,
Peut-être comme cela:
VB: 
Sub InsertImage()

   Dim ws As Worksheet
   Dim imagePath As String
   Dim image As Picture
   Dim imageRange As Range
'définition de la feuille et de la plage
   Set ws = Feuil1
   Set imageRange = ws.Range("K1:L7")
' Chemin du fichier image
   imagePath = ThisWorkbook.Path & "\photos\" & [C4].Text & ".jpg"
' Insérez l'image dans la feuille
   Set image = ws.Pictures.Insert(imagePath)
' Ajustez les dimensions de l'image à la plage spécifiée
   With image
        .Top = imageRange.Top
        .Left = imageRange.Left
        .Width = imageRange.Width
        .Height = imageRange.Height
   End With
 
End Sub
Cliquez pour agrandir...
Bonjour @piga25 😉,

Merci beaucoup. Certaines images débordent de la plage. Peut-être sont-elles un peu trop grandes.

Comment supprimer celle qui précède avant d’afficher la suivante? Les images sont l'une sur l'autre.

Bonne journée.
 
Vote positif 0 Vote négatif
Re
Pour supprimer l'image existante avant :
VB: 
Sub InsertImage()

   Dim ws As Worksheet
   Dim imagePath As String
   Dim image As Picture
   Dim imageRange As Range
   Dim pic As Picture
  
'définition de la feuille et de la plage
   Set ws = Feuil1
   Set imageRange = ws.Range("K1:L7")
' Supprimez les images existantes dans la plage spécifiée
   For Each pic In ws.Pictures
        If Not Intersect(pic.TopLeftCell, imageRange) Is Nothing Or _
           Not Intersect(pic.BottomRightCell, imageRange) Is Nothing Then
            pic.Delete
        End If
    Next pic
' Chemin du fichier image
   imagePath = ThisWorkbook.Path & "\photos\" & [C4].Text & ".jpg"
' Insérez l'image dans la feuille
   Set image = ws.Pictures.Insert(imagePath)
' Ajustez les dimensions de l'image à la plage spécifiée
   With image
        .Top = imageRange.Top
        .Left = imageRange.Left
        .Width = imageRange.Width
        .Height = imageRange.Height
   End With
 
End Sub
 
Vote positif 0 Vote négatif
Solution
piga25 à dit:
Re
Pour supprimer l'image existante avant :
VB: 
Sub InsertImage()

   Dim ws As Worksheet
   Dim imagePath As String
   Dim image As Picture
   Dim imageRange As Range
   Dim pic As Picture
 
'définition de la feuille et de la plage
   Set ws = Feuil1
   Set imageRange = ws.Range("K1:L7")
' Supprimez les images existantes dans la plage spécifiée
   For Each pic In ws.Pictures
        If Not Intersect(pic.TopLeftCell, imageRange) Is Nothing Or _
           Not Intersect(pic.BottomRightCell, imageRange) Is Nothing Then
            pic.Delete
        End If
    Next pic
' Chemin du fichier image
   imagePath = ThisWorkbook.Path & "\photos\" & [C4].Text & ".jpg"
' Insérez l'image dans la feuille
   Set image = ws.Pictures.Insert(imagePath)
' Ajustez les dimensions de l'image à la plage spécifiée
   With image
        .Top = imageRange.Top
        .Left = imageRange.Left
        .Width = imageRange.Width
        .Height = imageRange.Height
   End With
 
End Sub
Cliquez pour agrandir...
Pour moi bien que ça déborde pour quelques unes. Le résultat est très satisfaisant.
Je te remercie ça va me permettre d'avancer.
 
Vote positif 0 Vote négatif
Re
Et en ajustant proportionnellement l'image en fonction de sa hauteur ou de sa largeur
VB: 
Sub InsertImage()

    Dim ws As Worksheet
    Dim imagePath As String
    Dim image As Picture
    Dim imageRange As Range
    Dim pic As Picture
    Dim aspectRatio As Double
    Dim newWidth As Double
    Dim newHeight As Double
 
'définition de la feuille et de la plage
   Set ws = Feuil1
   Set imageRange = ws.Range("K1:L7")
' Supprimez les images existantes dans la plage spécifiée
   For Each pic In ws.Pictures
        If Not Intersect(pic.TopLeftCell, imageRange) Is Nothing Or _
           Not Intersect(pic.BottomRightCell, imageRange) Is Nothing Then
            pic.Delete
        End If
    Next pic
' Chemin du fichier image
   imagePath = ThisWorkbook.Path & "\photos\" & [C4].Text & ".jpg"
' Insérez l'image dans la feuille
   Set image = ws.Pictures.Insert(imagePath)
  
' Calculer le ratio de l'image originale
   aspectRatio = image.Width / image.Height
' Ajustez les dimensions de l'image en gardant le ratio
   If imageRange.Width / imageRange.Height > aspectRatio Then
' La plage est plus large que l'image, ajuster la hauteur
        newHeight = imageRange.Height
        newWidth = newHeight * aspectRatio
    Else
' La plage est plus haute que l'image, ajuster la largeur
        newWidth = imageRange.Width
        newHeight = newWidth / aspectRatio
    End If
    ' Positionnez et redimensionnez l'image
    With image
        .Top = imageRange.Top + (imageRange.Height - newHeight) / 2
        .Left = imageRange.Left + (imageRange.Width - newWidth) / 2
        .Width = newWidth
        .Height = newHeight
    End With
 
End Sub
 
Vote positif 0 Vote négatif
Re;
Regarde ce post, cela pourrait correspondre à ce que tu recherche:
excel-downloads.com

Microsoft 365 - Insertion Image dans une Feuille et Ratio conservé

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...
excel-downloads.com excel-downloads.com
 
Vote positif 0 Vote négatif
piga25 à dit:
Re
Et en ajustant proportionnellement l'image en fonction de sa hauteur ou de sa largeur
VB: 
Sub InsertImage()

    Dim ws As Worksheet
    Dim imagePath As String
    Dim image As Picture
    Dim imageRange As Range
    Dim pic As Picture
    Dim aspectRatio As Double
    Dim newWidth As Double
    Dim newHeight As Double
 
'définition de la feuille et de la plage
   Set ws = Feuil1
   Set imageRange = ws.Range("K1:L7")
' Supprimez les images existantes dans la plage spécifiée
   For Each pic In ws.Pictures
        If Not Intersect(pic.TopLeftCell, imageRange) Is Nothing Or _
           Not Intersect(pic.BottomRightCell, imageRange) Is Nothing Then
            pic.Delete
        End If
    Next pic
' Chemin du fichier image
   imagePath = ThisWorkbook.Path & "\photos\" & [C4].Text & ".jpg"
' Insérez l'image dans la feuille
   Set image = ws.Pictures.Insert(imagePath)
 
' Calculer le ratio de l'image originale
   aspectRatio = image.Width / image.Height
' Ajustez les dimensions de l'image en gardant le ratio
   If imageRange.Width / imageRange.Height > aspectRatio Then
' La plage est plus large que l'image, ajuster la hauteur
        newHeight = imageRange.Height
        newWidth = newHeight * aspectRatio
    Else
' La plage est plus haute que l'image, ajuster la largeur
        newWidth = imageRange.Width
        newHeight = newWidth / aspectRatio
    End If
    ' Positionnez et redimensionnez l'image
    With image
        .Top = imageRange.Top + (imageRange.Height - newHeight) / 2
        .Left = imageRange.Left + (imageRange.Width - newWidth) / 2
        .Width = newWidth
        .Height = newHeight
    End With
 
End Sub
Cliquez pour agrandir...
Merci beaucoup. Avec ce dernier, ça ne va pas.
Il a supprimé le bouton qui lançait la macro mais n'a pas supprimé l'image et a planté sur cette ligne
VB: 
Set image = ws.Pictures.Insert(imagePath)

à la seconde exécution, le code a fonctionnait. Merci pour le lien, je vais aller voir.
 
Vote positif 0 Vote négatif
Bonsoir
autant donner le lien original
excel-downloads.com

centrer une image dans un range en toute circonstances quel que soit le ratio (range/image)

bonjour a tous voici deux méthode avec exemple pour centrer une image sur un range la méthode que j'appelle directe en effet j'agit directement sur l'image en bloquant l'apect ratio...
excel-downloads.com excel-downloads.com
les images seront réduites ou "agrandies de f"acon "a ce qu'elle rentre totalement d"ans la plage sans perdre l'aspect ratio
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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

W
  • Résolu(e)
Microsoft 365 Insertion Image dans une Feuille et Ratio conservé
2
Réponses
23
Affichages
4 K
patricktoulon
patricktoulon
A
  • Question Question
Macro - centrer une image importé dans une cellule
Réponses
0
Affichages
2 K
Anarhim
A
M
[REF] Wiki 1 de MichelXld (Généralités Excel)
Réponses
6
Affichages
60 K
Le_Phénomène
Le_Phénomène
Retour