Automatiser l'insertion d'images dans excel

MZSIDE · 27 Février 2013

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.

tototiti2008 · 27 Février 2013

Re : Automatiser l'insertion d'images dans excel

Bonsoir MZSide,

Bienvenue sur XLD,

sans doute une piste par là Les images et shapes sur l'excellent site de Boisgontier

MZSIDE · 28 Février 2013

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]

tototiti2008 · 28 Février 2013

Re : Automatiser l'insertion d'images dans excel

Bonjour,

Je pense que la partie "Choix d'une image avec données/Validation" avec les images dans une autre feuille, et sans macro, correspond mieux à ton besoin.

MZSIDE · 28 Février 2013

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

MZSIDE · 28 Février 2013

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 ?

MZSIDE · 28 Février 2013

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.

MZSIDE · 2 Mars 2013

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.

tototiti2008 · 2 Mars 2013

Re : Automatiser l'insertion d'images dans excel

Bonjour MZSide,

Essaye de contrôle la valeur des variables L et H
ajoute par exemple la ligne

Msgbox L & " " & H

à la fin du code, et dis-nous si ça correspond à largeur et hauteur de l'image initiale

MZSIDE · 2 Mars 2013

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

tototiti2008 · 2 Mars 2013

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

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

tototiti2008 · 2 Mars 2013

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

MZSIDE · 2 Mars 2013

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é ?

tototiti2008 · 2 Mars 2013

Re : Automatiser l'insertion d'images dans excel

Re,

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

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

MZSIDE · 30 Octobre 2013

Re : Automatiser l'insertion d'images dans excel

6 mois plus tard, mais vaut mieux tard que jamais...

Un grand merci. avec tous vos conseils, j'ai réussi à faire ce que je voulais...

Merci, encore une fois.

Automatiser l'insertion d'images dans excel

MZSIDE

Guest

Pièces jointes

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

MZSIDE

Guest

MZSIDE

Guest

MZSIDE

Guest

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

tototiti2008

XLDnaute Barbatruc

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

Discussions similaires

Automatiser l'insertion d'images dans excel

MZSIDE

Guest

Pièces jointes

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

MZSIDE

Guest

MZSIDE

Guest

MZSIDE

Guest

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

tototiti2008

XLDnaute Barbatruc

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

tototiti2008

XLDnaute Barbatruc

MZSIDE

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency