Automatiser l'insertion d'images dans excel

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion MZSIDE
  • 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 !

S'inscrire
M

MZSIDE

Guest
Bonsoir,

Pour éviter de fastidieuses manipulations, je suis à la recherche d'une solution pour automatiser l'insertion de visuels (en feuille 1 colonne B situés en feuille 3 colonne B, avec ref en colonne A) dans un fichier excel à partir de la référence article feuille 1 colonne A.

L'explication est probablement incompréhensible. Aussi, ai je joint un extrait du fichier en question.

Merci de votre attention.

MZSIDE.
 

Pièces jointes

Trier par date Trier par votes
Re : Automatiser l'insertion d'images dans excel

EXCELLENT site de Boisgontier...

Dommage que je ne comprenne pas la totalité des explications. je suis parti du fichier importimage, avec la macro suivante

Sub ImportImages()
répertoirePhoto = "c:\mesdoc\"
suppression
Range("b2").Select
For Each c In [A2:A6]
nf = répertoirePhoto& c & ".jpg"
If Dir(nf) <> "" Then
Set img = ActiveSheet.Pictures.Insert(nf)
img.Left = c.Offset(, 1).Left
img.Top = c.Offset(, 1).Top
c.EntireRow.RowHeight = img.Height
End If
Next
End Sub

Sub suppression()
For Each i In ActiveSheet.Shapes
If i.Type = 13 Then i.Delete
Next i
End Sub

j'ai créé un fichier excel dans c mesdoc répertoirePhoto avec 2 colonnes (en A les réf, en b les photos insérés). refermer ce fichier.

Ouvre importimage, saisie des réf en colonne A, lancement de la macro et RIEN.

Ai je raté quelque chose , faut il modifier certaines lignes de la macro (la 6ème nf=) ou autre chose ?

Ai besoin de vos lumières. Mon fichier comporte 1300 photos.
Merci d'avance. MZSIDE.


Bienvenue sur XLD,

sans doute une piste par là Les images et shapes sur l'excellent site de Boisgontier[/QUOTE]
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

Je file voir cette rubrique.

Dans le cas précédent, j'ai repéré au moins une erreur de ma part. J'avais recréer un "index" ref photo dans un tableau. Or, il me semble avoir finalement compris qu'il faut dans un répertoire déposer toutes les images.

Merci. MZSIDE
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

Sur une base de 1300 articles, je souhaite faire apparaitre les visuels d'une sélection d'articles (55, 555 ou 1255). Donc, ce choix validation ne semble pas me convenir.

L'import d'images me semble plus approprié. Reste à comprendre pourquoi l'import échoue ?
Dans mon dossier c mesdoc, dois je recréer un dossier répertoirePhoto ?
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

Finalement, j'ai opté pour afficheimage.
Car l'importimage me posait des soucis de taille de la vignette.
Merci de m'avoir orienté vers le site de Boisgontier.
Cordialement. MZSIDE.
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

A partir du FABULEUX site de Jacques Boisgontier, j'extrait les photos de mon répertoire dans mon tarif. J'ai quelque peu modifié la "VBA", si le terme est juste de façon à ce que la photo s'adapte à la cellule de destination ;

Function AfficheImage(NomImage, Optional rep As String)
Application.Volatile
If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"
Set f = Sheets(Application.Caller.Parent.Name)
Set adr = Application.Caller
Set adr2 = Range(adr.Address).MergeArea
temp = NomImage & "_" & adr.Address
Existe = False
For Each s In adr.Worksheet.Shapes
If s.Name = temp Then Existe = True
Next s
If Not Existe Then
For Each k In adr.Worksheet.Shapes
p = InStr(k.Name, "_")
If Mid(k.Name, p + 1) = adr.Address Then k.Delete
Next k
f Dir(rep & NomImage) = "" Then
AfficheImage = "Inconnu"
Else
Set myShell = CreateObject("Shell.Application")
If TypeName(rep) = "Range" Then
Set myFolder = myShell.Namespace(rep.Value)
Else
Set myFolder = myShell.Namespace(rep)*
End If
Set myFile = myFolder.Items.Item(NomImage)
Taille = myFolder.GetDetailsOf(myFile, 26)
H = Val(Split(Taille, "x")(1))
L = Val(Split(Taille, "x")(0))
Ech = adr.Height / H
L = L * Ech
f.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, L, H).Name = NomImage & "_" & adr.Address
AfficheImage = "ok"
End If
End If
End Function

La dernière difficulté, que je n'arrive pas à résoudre, est de respecter la proportion initiale. En clair, des photos de bacs élancés (85 cm de haut pour un diamètre de 30 cm) sont déformées pour sembler être de 30x30cm.

Quelle ligne dois je modifier ?

Merci de votre éclairage.

MZSIDE.
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

MErci de ta réponse. Mes connaissances étant limitées, je ne comprends pas parfaitement ton message. Que dois je rajouter et ou ?
Ai testé ces 2 cas ;

H = Val(Split(Taille, "x")(1)) Msgbox L & " " & H
L = Val(Split(Taille, "x")(0)) Msgbox L & " " & H IMAGE TOUJOURS DEFORMEE

H = Msgbox L & " " & H
L = Msgbox L & " " & H IMAGE TOUJOURS DEFORMEE
Merci. MZSIDE
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

Re,

Si tu vas dans le mode avancé pour éditer tes messages, tu as une balise Code (#) qui permettra de présenter le code VBA dans les message, c'est plus lisible
Essaye ça

Code: 
Function AfficheImage(NomImage, Optional rep As String)
  Application.Volatile
  If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"
  Set f = Sheets(Application.Caller.Parent.Name)
  Set adr = Application.Caller
  Set adr2 = Range(adr.Address).MergeArea
  temp = NomImage & "_" & adr.Address
  Existe = False
  For Each s In adr.Worksheet.Shapes
     If s.Name = temp Then Existe = True
  Next s
  If Not Existe Then
     For Each k In adr.Worksheet.Shapes
      p = InStr(k.Name, "_")
      If Mid(k.Name, p + 1) = adr.Address Then k.Delete
     Next k
f Dir(rep & NomImage) = "" Then
      AfficheImage = "Inconnu"
    Else
      Set myShell = CreateObject("Shell.Application")
  If TypeName(rep) = "Range" Then
          Set myFolder = myShell.Namespace(rep.Value)
Else
  Set myFolder = myShell.Namespace(rep)*
      End If
      Set myFile = myFolder.Items.Item(NomImage)
   Taille = myFolder.GetDetailsOf(myFile, 26)
      H = Val(Split(Taille, "x")(1))
      L = Val(Split(Taille, "x")(0))
Msgbox L & " " & H
      Ech = adr.Height / H
      L = L * Ech
Msgbox L & " " & H
      f.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, L, H).Name = NomImage & "_" & adr.Address
      AfficheImage = "ok"
 End If
End If
End Function

Et tu notes les valeurs qui s'affichent dans les Msgbox (les 2 séries), et tu nous donne aussi la taille (en pixels) de ton image originale que tu insères

IMAGE TOUJOURS DEFORMEE
Cliquez pour agrandir...

Oui, et elle sera toujours déformée après ça, j'essaie de comprendre ce qui se passe, comme je n'ai pas tes images ce n'est pas simple
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

Re,

Peut-être comme ça

Code: 
Function AfficheImage(NomImage, Optional rep As String)
  Application.Volatile
  If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"
  Set f = Sheets(Application.Caller.Parent.Name)
  Set adr = Application.Caller
  Set adr2 = Range(adr.Address).MergeArea
  temp = NomImage & "_" & adr.Address
  Existe = False
  For Each s In adr.Worksheet.Shapes
     If s.Name = temp Then Existe = True
  Next s
  If Not Existe Then
     For Each k In adr.Worksheet.Shapes
      p = InStr(k.Name, "_")
      If Mid(k.Name, p + 1) = adr.Address Then k.Delete
     Next k
f Dir(rep & NomImage) = "" Then
      AfficheImage = "Inconnu"
    Else
      Set myShell = CreateObject("Shell.Application")
  If TypeName(rep) = "Range" Then
          Set myFolder = myShell.Namespace(rep.Value)
Else
  Set myFolder = myShell.Namespace(rep)*
      End If
      Set myFile = myFolder.Items.Item(NomImage)
   Taille = myFolder.GetDetailsOf(myFile, 26)
      H = Val(Split(Taille, "x")(1))
      L = Val(Split(Taille, "x")(0))
      Ech = adr.Height / H
      L = L * Ech
H = adr.Height
      f.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, L, H).Name = NomImage & "_" & adr.Address
      AfficheImage = "ok"
 End If
End If
End Function
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

Ai recopié le 2ème code, que tu m'as indiqué. Sans plus de succès.

1er code ; Et tu notes les valeurs qui s'affichent dans les Msgbox (les 2 séries) ; je ne peux pas te répondre, car ne comprend pas le sens ? il n'y a pas que les Inconnus qui font "répéter la question" !

Voici un échantillon des photos, que je souhaite insérer. Est ce que la diffficulté viendrait de leur disparité ?
 
Vote positif 0 Vote négatif
Re : Automatiser l'insertion d'images dans excel

Re,

il n'y a pas que les Inconnus qui font "répéter la question" !
Cliquez pour agrandir...

Bon, ok, on est pas à Télé Magouille non plus 😉 (on s'en met pas plein les fouilles)
Oublie les Msgbox
Essaye comme ça

Code: 
Function AfficheImage(NomImage, Optional rep)
    Application.Volatile
    If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"
    Set f = Sheets(Application.Caller.Parent.Name)
    Set adr = Application.Caller
    Set adr2 = Range(adr.Address).MergeArea
    temp = NomImage & "_" & adr.Address
    Existe = False
    For Each s In adr.Worksheet.Shapes
        If s.Name = temp Then Existe = True
    Next s
    If Not Existe Then
        For Each k In adr.Worksheet.Shapes
            p = InStr(k.Name, "_")
            If Mid(k.Name, p + 1) = adr.Address Then k.Delete
        Next k
        If Dir(rep & NomImage) = "" Then
            AfficheImage = "Inconnu"
        Else
            Set myShell = CreateObject("Shell.Application")
            If TypeName(rep) = "Range" Then
                Set myFolder = myShell.Namespace(rep.Value)
            Else
                Set myFolder = myShell.Namespace(rep)
            End If
            Set myFile = myFolder.Items.Item(NomImage)
            Taille = myFolder.GetDetailsOf(myFile, 26)
            H = Val(Split(Taille, "x")(1))
            L = Val(Split(Taille, "x")(0))
            Ech = adr.Height / H
            L = L * Ech
            H = adr.Height
            f.Shapes.AddPicture(rep & NomImage, True, True, adr.Left, adr.Top, L, H).Name = NomImage & "_" & adr.Address
            AfficheImage = "ok"
        End If
    End If
End Function

Essayer, ça veut dire : tu remplaces le code de ta fonction, tu supprimes les images de ta feuille, tu revalides tes fonctions dans la feuille de calcul
 
Dernière édition:
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
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

G
  • Question Question
Microsoft 365 Avoir des classeurs maitres et les procédures dans un autre classeur.
2
Réponses
19
Affichages
2 K
GClaire
G
L
  • Résolu(e)
Power Query Problème de fusion de données entre deux fichiers Excel sous Power Query
Réponses
8
Affichages
1 K
chris
chris
N
  • Résolu(e)
XL 2019 Automatiser la répartition des effectifs dans une feuille de calcul
Réponses
4
Affichages
913
Nasseuz
N
E
  • Résolu(e)
Microsoft 365 Problème d'organisation des colonnes dans une ListBox en VBA Excel
Réponses
2
Affichages
1 K
eCHO
E
R
  • Résolu(e)
XL 2016 Automatiser le nom de la feuille dans une formule
Réponses
3
Affichages
908
Rabeto
R
V
  • Résolu(e)
XL 2019 Gestion de stock EQUIV, INDEX, ...
Réponses
6
Affichages
1 K
vilcoyotte90
V
L
  • Question Question
XL 2019 Formule ou VBA intersection tableau selon deux colonnes et une ligne
Réponses
7
Affichages
1 K
Hasco
Hasco
P
  • Question Question
Microsoft 365 Date statique dans Excel en VB avec colonne protégée
Réponses
13
Affichages
829
pca2471
P
M
  • Résolu(e)
Microsoft 365 Image stockée dans une feuille à l'initialisation du userform
2
Réponses
20
Affichages
2 K
meyscal
M
A
  • Résolu(e)
Microsoft 365 [VBA] Macro pour automatiser une sortie
2 3
Réponses
37
Affichages
4 K
asso78Lim
A
A
  • Résolu(e)
Microsoft 365 Formule Excel pour modifier la "référence" dans une colonne
Réponses
2
Affichages
820
AlexiaC
A
C
  • Question Question
Microsoft 365 Vérifier si la valeur existe dans deux feuilles excel
Réponses
1
Affichages
868
Dranreb
Dranreb
B
  • Question Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
1 K
job75
job75
Cédric06400
  • Résolu(e)
XL 2019 Problème de rapidité exécution
Réponses
11
Affichages
1 K
Cédric06400
Cédric06400
C
  • Question Question
XL 2016 VBA - Insertion de lignes automatique sous condition et copier formats et formules dans la nouvelle ligne
Réponses
10
Affichages
2 K
clochette
C
F
  • Question Question
Microsoft 365 Recherche mot Excel avec copie sur un autre tableau
Réponses
5
Affichages
763
Fybu13
F
N
  • Résolu(e)
XL 2021 Jointure Excel multicritères
Réponses
3
Affichages
506
Nasseuz
N
F
  • Question Question
XL 2016 macro import excel et mise à jour tableau d'analyse
Réponses
8
Affichages
1 K
chris
chris
J
  • Résolu(e)
XL 2016 Aide Macro VBA - Reporter valeurs Feuille 1 dans une autre feuille 2 à partir d'une certaine cellule
Réponses
9
Affichages
5 K
jo77
J
S
  • Question Question
XL 2019 Parcourir un tableau afin d'extraire des dates comprises dans un intervalle
2
Réponses
16
Affichages
3 K
sylvanu
sylvanu
Retour