Insérer et redimensionner des images dans Excel

Bonjour,

Je dois créer des listes de produits sous excel (version Mac 2011 FR 14.3.8).

Mon principale problème consiste à intégrer de manière automatique des photos de ces produits dans une colonne spécifique.

Pour l'instant, je drag & drop l'image depuis un fichier dans la feuille excel, la redimensionne manuellement (avec la touche Maj - pour garder les proportions) et la déplace dans la cellule adéquate.

Je suis complètement néophyte en macro et en vba.

Cependant, je cherche à savoir si une macro pourrait me faire gagner du temps et si elle ne pourrait pas aller chercher la photo via un chemin que je lui indiquerai dans une des colonnes (type /Users/Nicolas/Downloads/IMG_2530.JPG) ou en fonction de la référence (en allant chercher l'image avec la même référence qui serait dans le même dossier que le fichier excel si cela est plus facile à coder sous vba).

Il faudrait aussi que la photo se redimensionne automatiquement à la hauteur des cellules de cette colonne.

Merci d'avance pour votre aide.

Salut Stivinho,

Dans cet exemple tu vois les attributs:

With Img.ShapeRange
            'Nommer l'image insérée (Pour la supprimer plus facilement ensuite)
            .Name = "Cible"
            .LockAspectRatio = msoFalse
            .Left = Emplacement.Left
            .Top = Emplacement.Top
            .Height = Emplacement.Height
            .Width = Emplacement.Width
        End With

Ici on voit surtout le .left et.top pour déterminer la position de l'image et le .Height et .Width pour ses dimensions.

Tu peux aussi aller dans l'aide Excel et rechercher "ShapeRange" qui t'indiquera comment utiliser tout cela dont aussi un "scaleheight" si cela peut t'aider

Enfin tu peux aussi appeler les attributs de tes cellules via par exemple :

Cells(1, 1).RowHeight = 10
Cells(1, 1).ColumnWidth = 10

Donc par exemple si j'ai une image qui s'appelle "TOTO" dans ma Feuil1, après l'avoir inséré via l'aide ci-dessus, tu peux dire :

'on position l'image sur la case en question
Sheets("Feuil1").Shapes("TOTO").Left = Cells(1, 1).Left

'on met la même hauteur que la cellule
Sheets("Feuil1").Shapes("TOTO").Height = Cells(1, 1).RowHeight

A toi de voir ce que tu veux faire.

Reviens vers nous si tu bloques toujours après avoir fait une petite macro

ECG

Merci d'avoir pris le temps de me répondre.

Je pense cependant qu'il va falloir que je commence par suivre quelques tuto de programmation en macro/vba afin de bien comprendre tout ce que vous m'avez écrit!

Oui il faut se renseigner un peu, regarder les tutos etc puis on avance, on pose des questions et comme cela on progresse

C'est la bonne méthode et surtout c'est beaucoup plus intéressant quand on comprends un minimum ce qu'on nous file même si forcément il y a toujours des choses à apprendre en programmation !et pour tout le monde!

C'est mieux que de demander des macros toutes faites surtout que la plupart du temps les gens ne savent pas vraiment ce qu'ils veulent ou ne pense pas au cas particuliers de leurs fichier donc les macros faite comme ça directement par des autres membres sans avoir la possibilité/capacité de modifier quelques lignes soi même... ça explose en vol rapidement je pense

Après on se fera un plaisir de t'aider si tu veux comprendre des fonctions, savoir comment faire des choses ou corriger ce qui bug dans ton code.

Si tu as des questions sur le code en particulier n'hésite pas à me MP

ECG

Bonjour

Pour apporter une piste sur redimensionner les images (code pas testé) :

Sub Dimention()

Debut:
Largeur = InputBox("Choisir la largeur :", "Largeur des images")
Hauteur = InputBox("Choisir la hauteur :", "Hauteur des images")

If Largeur = "" Or Hauteur = "" Or Not IsNumeric(Largeur) Or Not IsNumeric(hauter) Then
    If MsgBox("Largeur ou hauteur définie incorrecte.", vbCritical + vbRetryCancel) = vbRetry Then
        GoTo Debut
    Else
        Exit Sub
    End If
Else
    ActiveSheet.Pictures.Width = Largeur
    ActiveSheet.Pictures.Height = Hauteur
End If

End Sub

Voilà quelque chose de plus aboutit :

Dim Largeur, Hauteur
Sub Dimention()
Dim Code

Etape1:

If MsgBox("Garder les proportions au moment du redimentionnement des images ?", vbInformation + vbYesNo, "Redimentionner") = vbYes Then
    Code = InputBox("Tappez 1 pour redimentionner la largeur ou 2 pour redimentionner la hauteur", "Choix de l'axe à redimentionner")
    If Code = 0 Or Not IsNumeric(Code) Then
        If MsgBox("Code invalide", vbCritical + vbRetryCancel, "Erreur code") = vbRetry Then GoTo Etape1 Else Exit Sub
    End If
Etape2:
    If Code = 1 Then
        Largeur = InputBox("Choisir la largeur :", "Largeur des images")
        If Largeur = "" Or Not IsNumeric(Largeur) Then
            If MsgBox("Largeur définie incorrecte.", vbCritical + vbRetryCancel, "Erreur dimention") = vbRetry Then GoTo Etape2 Else Exit Sub
        Else
            RedimLargeur
        End If
    End If
Etape3:
    If Code = 2 Then
        Hauteur = InputBox("Choisir la hauteur :", "Hauteur des images")
        If Hauteur = "" Or Not IsNumeric(Hauteur) Then
            If MsgBox("Hauteur définie incorrecte.", vbCritical + vbRetryCancel, "Erreur dimention") = vbRetry Then GoTo Etape3 Else Exit Sub
        Else
            RedimHauteur
        End If
    End If
Else
Etape4:
    Largeur = InputBox("Choisir la largeur :", "Largeur des images")
    Hauteur = InputBox("Choisir la hauteur :", "Hauteur des images")
    If Largeur = "" Or Not IsNumeric(Largeur) Or Hauteur = "" Or Not IsNumeric(Hauteur) Then
        If MsgBox("Largeur ou hauteur définie incorrecte.", vbCritical + vbRetryCancel, "Erreur dimention") = vbRetry Then GoTo Etape4 Else Exit Sub
    Else
        LargeurEtHauteur
    End If
End If

End Sub
Private Sub RedimLargeur()

With ActiveSheet.Pictures.ShapeRange
    .LockAspectRatio = msoTrue
    .Width = Largeur
End With

End Sub

Private Sub RedimHauteur()

With ActiveSheet.Pictures.ShapeRange
    .LockAspectRatio = msoTrue
    .Height = Hauteur
End With

End Sub

Private Sub LargeurEtHauteur()

With ActiveSheet.Pictures.ShapeRange
    .LockAspectRatio = msoFalse
    .Width = Largeur
    .Height = Hauteur
End With

End Sub

Fichier avec application

code utilisé :

Sub Dimention()
'La variable LargeurInit et HauteurInit vont représenter les dimentions en largeur et hauteur de la première image
'La variable Largeur et hauteur vont représentées les dimentions des images en cm définie par l'utilisateur
'La variable Code va représenter le choix que l'utilisateur va faire quant au choix de garder les proportions ou non sur le redimentionnement des images
'La variable LaFeuille va représenter la feuille sur laquelle se trouve les images à redimentionner

Dim LargeurInit, HauteurInit, Largeur, Hauteur, Code
Dim LaFeuille As Worksheet
Dim Ratio As Single

Set LaFeuille = ThisWorkbook.Worksheets("Feuil1") 'Choix de la feuille sur laquelle se trouve les images à redimentionner

Ratio = 28.35 'La variable "Ratio" est le rapport de grandeur entre une valeur en point et une valeur en cm

'La variable LargeurInit représente le rapport entre la longueur de la largeur de la première image de Lafeuille en point sur Ratio pour obtenir _
une longueur en cm
LargeurInit = Format(LaFeuille.Pictures.ShapeRange(1).Width / Ratio, "#0.00")

'Idem pour la hauteur avec la variable HauteurInit
HauteurInit = Format(LaFeuille.Pictures.ShapeRange(1).Height / Ratio, "#0.00")

'Si l'utilisateur répond oui au message de redimentionnement alors :
Debut:
If MsgBox("Garder les proportions au moment du redimentionnement des images ?", vbInformation + vbYesNo, "Redimentionner") = vbYes Then
    'La varibale "Code" prend pour valeur la saisie faite par l'utilisateur

Etape1:
    Code = Application.InputBox("Tappez l'un des codes ci-dessous :" & Chr(10) & Chr(10) & _
                                "1 : Redimentionner via la largeur" & Chr(10) & _
                                "2 : Redimentionner via la longeur" & Chr(10) & _
                                "3 : Retrouner en arrière" & Chr(10) & _
                                "4 : Pour quitter", "Choix de l'axe à redimentionner")
    If Code = False Then Exit Sub 'Si la saisie est annulée ou la valeur saisie = 0 le code est stoppé
    If Code = 3 Then GoTo Debut 'Si Code = 3 alors le code reprend à la ligne Debut
    If Code = 4 Then Exit Sub 'Si Code = 4 alors le code est stoppé ici
    If Code <> 1 And Code <> 2 And Not IsNumeric(Code) Then 'Si "Code" est différent de 1 et de 2 et n'est pas numérique alors :
        'Un message d'erreur apprait à l'utilisteur, s'il essaye à nouveau le code reprend à la ligne Etape1
        If MsgBox("Code invalide", vbCritical + vbRetryCancel, "Erreur code") = vbRetry Then GoTo Etape1 Else Exit Sub
    End If 'Fin de si "Code" est incorrecte
Etape2:
    If Code = 1 Then 'Si "Code" = 1 alors :
        'La variable "Largeur" prend pour valeur la saisie faite par l'utilisateur
        Largeur = Application.InputBox("Choisir la largeur (en cm) :", "Largeur des images", LargeurInit)
        If Largeur = False Then Exit Sub 'Si la saisie est annulée le code est stoppé
        If Largeur = "" Or Not IsNumeric(Largeur) Then 'Si la variable Largeur est vide ou non numérique alors :
            'Un message d'erreur apprait à l'utilisateur, s'il essaye à nouveau le code reprend à la ligne Etape2
            If MsgBox("Largeur définie incorrecte.", vbCritical + vbRetryCancel, "Erreur dimention") = vbRetry Then GoTo Etape2 Else Exit Sub
        Else 'Sinon :
            With LaFeuille.Pictures.ShapeRange 'Avec les images sur LaFeuille
                .LockAspectRatio = msoTrue 'La fonction garder les proportion est activée
                .Width = Application.CentimetersToPoints(Largeur) 'La largeur des images est définie par la variable Largeur convertie en cm
            End With 'Fin du travail avec les images sur LaFeuille
        End If 'Sin du si "Code"=1
    End If
Etape3:
    If Code = 2 Then
        Hauteur = Application.InputBox("Choisir la hauteur (en cm) :", "Hauteur des images", HauteurInit)
        If Hauteur = False Then Exit Sub
        If Hauteur = "" Or Not IsNumeric(Hauteur) Then
            If MsgBox("Hauteur définie incorrecte.", vbCritical + vbRetryCancel, "Erreur dimention") = vbRetry Then GoTo Etape3 Else Exit Sub
        Else
            With LaFeuille.Pictures.ShapeRange
                .LockAspectRatio = msoTrue
                .Height = Application.CentimetersToPoints(Hauteur)
            End With
        End If
    End If
Else
Etape4:
    Largeur = Application.InputBox("Choisir la largeur (en cm) :", "Largeur des images", LargeurInit)
    If Largeur = False Then Exit Sub
    Hauteur = Application.InputBox("Choisir la hauteur (en cm) :", "Hauteur des images", HauteurInit)
    If Hauteur = False Then Exit Sub
    If Largeur = "" Or Not IsNumeric(Largeur) Or Hauteur = "" Or Not IsNumeric(Hauteur) Then
        If MsgBox("Largeur ou hauteur définie incorrecte.", vbCritical + vbRetryCancel, "Erreur dimention") = vbRetry Then GoTo Etape4 Else Exit Sub
    Else
        With LaFeuille.Pictures.ShapeRange
            .LockAspectRatio = msoFalse 'La fonction garder les proportion désactivée
            .Width = Application.CentimetersToPoints(Largeur)
            .Height = Application.CentimetersToPoints(Hauteur)
        End With
    End If
End If
End Sub
166imagesredim.xlsm (228.12 Ko)
Rechercher des sujets similaires à "inserer redimensionner images"