Theodavid
Messages postés11Date d'inscriptiondimanche 24 décembre 2000StatutMembreDernière intervention23 octobre 2008
-
16 oct. 2008 à 00:12
Utilisateur anonyme -
17 juin 2009 à 09:38
Bonjour,
voilà mon problème :
j'ai une liste de 700 produits avec leurs références dans un tableau excel et j'ai un dossier avec les 700 images nomées par la référence de chacun des produits .
Comment joindre les deux sur une même ligne excel ?
Theodavid
Messages postés11Date d'inscriptiondimanche 24 décembre 2000StatutMembreDernière intervention23 octobre 2008 19 oct. 2008 à 11:52
Super Orohena !!!! ça marche vraiement trés bien !
je t'en remerci cela va beaucoup m'aider !!!
Je donne la solution final pour ceux qui sont interessé :
Sub j_espere_que_ca_marche()
Dim i As Integer, path As String, sep As String, img As String
sep = Application.PathSeparator
path = ActiveWorkbook.path & sep & "images" & sep
' balaye les 700 lignes
For i = 1 To 700
' indique à Excel où insérer l'image
Cells(i, 2).Select
' insère une image jpg
img = path & Cells(i, 1).Value & ".jpg"
If Dir(img) = "" Then
MsgBox "Image """ & img & """ non trouvée"
Else
ActiveSheet.Pictures.Insert(path & Cells(i, 1).Value & ".jpg").Select
End If
' ajuste la hauteur de la ligne, avec une marge inférieure de 10 pts
Rows(i).RowHeight = Selection.Height + 10
Selection.Top = Cells(i, 2).Top
Selection.Left = Cells(i, 2).Left
Next
cs_Orohena
Messages postés577Date d'inscriptionvendredi 26 septembre 2008StatutMembreDernière intervention20 novembre 20104 16 oct. 2008 à 07:18
Bonjour Theodavid
Si tes noms de produit sont dans les lignes 1 à 700 de la colonne A, et que ton répertoire d'images s'appelle "images" et se trouve dans le répertoire du classeur Excel, alors le code suivant devrait t'insérer les images dans les lignes 1 à 700 de la colonne B.
Sub j_espere_que_ca_marche()
Dim i As Integer, path as string, sep as string
sep = application.pathSeparator
path = activeWorkbook.path & sep & "images" & sep
' balaye les 700 lignes
For i = 1 To 700
' indique à Excel où insérer l'image
Cells(i, 2).Select
' insère une image jpg
ActiveSheet.Pictures.Insert(path & cells(i,1).value & ".jpg").Select
' ajuste la hauteur de la ligne, avec une marge inférieure de 10 pts
Rows(i).RowHeight = Selection.Height + 10
Next
End Sub
Cordialement
Il faut qu'une porte soit ouverte ... ou d'une autre couleur (Pierre Dac)
cs_Orohena
Messages postés577Date d'inscriptionvendredi 26 septembre 2008StatutMembreDernière intervention20 novembre 20104 16 oct. 2008 à 08:48
A priori, cette erreur signifie qu'un fichier jpg est introuvable. Essaie le code ci-dessous : si un fichier jpg est introuvable, une boîte de message te donnera le chemin de l'image que le programme n'est pas parvenu à insérer. Il te sera plus facile de déboguer.
PS : je suis en Polynésie, et il est tard. Je me reconnecterai vers 18 h (heure de France) pour savoir où tu en es...
Sub j_espere_que_ca_marche()
Dim i As Integer, path as string, sep as string, img as string
sep = application.pathSeparator
path = activeWorkbook.path & sep & "images" & sep
' balaye les 700 lignes
For i = 1 To 700
' indique à Excel où insérer l'image
Cells(i, 2).Select
' insère une image jpg
img = path & cells(i,1).value & ".jpg"
if dir(img) = "" then
msgbox "Image """ & img & """ non trouvée"
else
ActiveSheet.Pictures.Insert(path & cells(i,1).value & ".jpg").Select
endif
' ajuste la hauteur de la ligne, avec une marge inférieure de 10 pts
Rows(i).RowHeight = Selection.Height + 10
Next
End Sub
Cordialement
Vous n’avez pas trouvé la réponse que vous recherchez ?
cs_Orohena
Messages postés577Date d'inscriptionvendredi 26 septembre 2008StatutMembreDernière intervention20 novembre 20104 16 oct. 2008 à 08:51
Oups ! c'est mieux de remplacer la ligne
ActiveSheet.Pictures.Insert(path & cells(i,1).value & ".jpg").Select
par la suivante
ActiveSheet.Pictures.Insert(img).Select
Theodavid
Messages postés11Date d'inscriptiondimanche 24 décembre 2000StatutMembreDernière intervention23 octobre 2008 17 oct. 2008 à 08:46
Euuu ... je ne vois pas ce que tu veux me montrer :s
Mais mon problème principal après quelques testes c'est que les images ne s'insèrent pas en face de leurs références et les cellules ne ce dimension pas à l'image ...
J'ai trouvé sur un autre sujet une solution qui m'a l'air sympa mais que je n'arrive pas à coupler avec la tienne :
Sub Insère_Image_Dans_Cellule2()
Application.ScreenUpdating = False
Set image = ActiveSheet.Pictures.Insert _
("D:\Mes documents\Mes images\alien4.gif")
image.TopLeftCell.Select
With Selection
L = .ColumnWidth
H = .RowHeight
End With
With image
.Width = L * 5.286
.Height = H
.Left = .Left + 2
End With
End Sub
Tu crois qu'il serait possible de faire quelque chose d’équivalent ?
cs_Orohena
Messages postés577Date d'inscriptionvendredi 26 septembre 2008StatutMembreDernière intervention20 novembre 20104 17 oct. 2008 à 19:14
Bonjour TheoDavid
Pour éviter de tourner en rond, voilà ce que je te propose :
Tu me donnes :
a) le nom d'un produit
b) la cellule qui contient ce nom de produit
c) le chemin d'accès complet de l'image correspondante
d) la cellule où tu veux insérer l'image
En réponse, je t'enverrai le code qui insèrera l'image dans la cellule indiquée.
a) EPD1006147-M
b) D1
c) C:\Users\Théo\Pictures\Excel\images
d) D2
sachant que mon classeur excel est dans le dossier "Excel"
Moi j'ai fait comme ça :
Sub j_espere_que_ca_marche()
Dim i As Integer, path As String, sep As String, img As String
sep = Application.PathSeparator
path = ActiveWorkbook.path & sep & "images" & sep
' balaye les 700 lignes
For i = 1 To 12
' indique à Excel où insérer l'image
Cells(i, 2).Select
' insère une image jpg
img = path & Cells(i, 1).Value & ".jpg"
If Dir(img) = "" Then
MsgBox "Image """ & img & """ non trouvée"
Else
ActiveSheet.Pictures.Insert(path & Cells(i, 1).Value & ".jpg").Select
End If
' ajuste la hauteur de la ligne, avec une marge inférieure de 10 pts
Rows(i).RowHeight = Selection.Height + 10
Next
End Sub
Le programe marche au final, mais les images ne s'inserent pas au bonne endroit ...
cs_Orohena
Messages postés577Date d'inscriptionvendredi 26 septembre 2008StatutMembreDernière intervention20 novembre 20104 18 oct. 2008 à 02:39
Ok, TheoDavid, cela signifie qu'il faut positionner explicitement l'image par ses propriétés top et left. Pour cela, je te suggère d'insérer les deux instructions ci-dessous juste avant la ligne "Next" :
Theodavid
Messages postés11Date d'inscriptiondimanche 24 décembre 2000StatutMembreDernière intervention23 octobre 2008 20 oct. 2008 à 10:34
Bonjour Orohena,
Ok, parfait :) ça marche nickel
Je viens de me rendre compte que j'ai un autre trés gros soucie ...
J'ai en fait une base de donnée avec toutes les images qui y sont regroupées, mais il y a plein de dossiers et de sous dossiers pour les trier par catégorie ...
Penses-tu que le programe pourrait aller rechercher les images dans un dossier contenant plusieurs dossiers et
sous-dossiers ?
cs_Orohena
Messages postés577Date d'inscriptionvendredi 26 septembre 2008StatutMembreDernière intervention20 novembre 20104 20 oct. 2008 à 11:44
Est-ce que c'est l'utilisateur qui dira au programme où aller chercher l'image, ou bien c'est le programme qui devra se débrouiller ; dans ce cas, à quelles règles devra-t-il obéir ?
cs_Orohena
Messages postés577Date d'inscriptionvendredi 26 septembre 2008StatutMembreDernière intervention20 novembre 20104 21 oct. 2008 à 00:57
Bonjour TheoDavid
Si je comprends bien, il faut chercher l'image dans toute l'arborescence du dossier Images. En principe, la solution est la suivante :
1. procédure j_espere_que_ca_marche( ), modifiée
Sub j_espere_que_ca_marche()
Dim i As Integer, path As String, sep As String, img As String
sep = Application.PathSeparator
path = ActiveWorkbook.path & sep & "images" & sep
' balaye les 700 lignes
For i = 1 To 700
' cherche et insere une image jpg
img = Cells(i, 1).Value & ".jpg"
img = recurseChercheFichier (path, img)
If img = "" Then
MsgBox "Image """ & img & """ non trouvée"
Else
' ajuste la hauteur de la ligne, avec une marge inférieure de 10 pts
Rows(i).RowHeight = Selection.Height + 10
ActiveSheet.Pictures.Insert(img).Select
Selection.Top = Cells(i, 2).Top
Selection.Left = Cells(i, 2).Lef
endif
Next
End Sub
2 . voici la fonction qui cherche un fichier dans l'arborescence d'un répertoire.
Comme elle est réutilisable pour d'autres applications, j'ai banalisé les noms.
Function recurseChercheFichier(rep As String, nomFich As String) As String
'
' recherche récursivement le fichier nomFich dans
' le repertoire rep et dans ses sous-repertoires
'
Dim fileSys ' objet representant le systeme de fichiers
Dim repertoireCourant ' objet Folder representant le repertoire courant
Dim sousRepertoires ' objet Folders representant les sous-repertoires
Dim sousRepertoire ' objet Folder representant l'un des sous-repertoires
Dim sep As String ' separateur ("" pour Windows)
Dim cible As String ' chemin du fichier dans le repertoire courant
Dim Erreur as Boolean
sep = Application.PathSeparator
Set fileSys = CreateObject("Scripting.fileSystemObject")
cible = rep & sep & nomFich ' chemin du fichier dans le repetoire courant
If fileSys.fileExists(cible) Then
' le fichier a ete trouve dans le repertoire courant
recurseChercheFichier = cible
Exit Function
End If
' creer un objet Folder representant le repertoire courant
Set repertoireCourant = fileSys.getfolder(rep)
' creer une collection Folders representant les sous-repertoires
Set sousRepertoires = repertoireCourant.subfolders
' balayer la collection en creant un objet Folder pour chaque sous-repertoire
on Error GoTo erreurAccesRep
Erreur = false
cible = ""
For Each sousRepertoire In sousRepertoires
' recherche le fichier par iteration
if not Erreur then cible = _
recurseChercheFichier(rep & sep & sousRepertoire.Name, nomFich)
' le fichier a ete trouve dans un sous-repertoire
If cible <> "" Then
recurseChercheFichier = cible
Exit Function
End If
Next
on Error GoTo 0
' le fichier n'a ete trouve ni dans le repertoire
' courant ni dans ses sous-repertoires
recurseChercheFichier = ""
Exit Function
erreurAccesRep:
Erreur = True
resume next
End Function
3. Si ça peut t'aider, voici le programme qui m'a servi à mettre au point la fonction recurseChercheFichier()
Sub test()
' recherche le fichier Collines.jpg à partir de C:\Documents and Settings
Dim chem As String
chem = recurseChercheFichier("C:\Documents and Settings", "Collines.jpg")
MsgBox chem ' affiche "c:\... Echantillons d'images\Collines.jpg"
End Sub
Theodavid
Messages postés11Date d'inscriptiondimanche 24 décembre 2000StatutMembreDernière intervention23 octobre 2008 23 oct. 2008 à 12:43
Bonjour Ohroena,
Ce programme est vraiment trés bien, il recherche rapidement les images c'est vraiment super !! :)
Mais j'ai encore 2 dernières petite choses à te demander :
premièrement :
est ce qu'il serait possible que le programme insert plusieurs images pour la même référence
exemple : mon produit s'appel ADJ1087002
Et mais images s'appelent ADJ1087002-1, ADJ1087002-2, ADJ1087002-3, ADJ1087002-B,
ADJ1087002-S ou ADJ1087002-M. en gros c'est des ADJ1087002-*
si chaque image pouvait s'insérer dans une case différente ça serait vraiment bien mais c'est pas graver si elle vont dans la même case.
Deuxiemement :
La boîte m'affichant les erreurs m'empeche de lancer la recherche pendant toute une nuit ... serait il possible de l'enlever sans que le programme ne beug quand il n'y a pas d'image ?
cs_Orohena
Messages postés577Date d'inscriptionvendredi 26 septembre 2008StatutMembreDernière intervention20 novembre 20104 24 oct. 2008 à 01:59
Salut Theodavid
Dis-moi, notre discussion, c'est comme Gloire et Beauté, on sait quand ça commence mais on sait pas quand ça finit !
Pour la 2e question :
j'avais compris qu'à chaque nom de produit correspondait une image. Il paraissait donc logique de signaler toute exception à cette règle par un message. La suppression de l'instruction msgbox ne perturbe pas du tout le déroulement du programme.
Pour la 1e question :
Si on appelle racine le nom de produit, tel que ADJ1087002, et suffixe ce que tu dois concaténer pour obtenir le nom d'une image (suffixe"", suffixe "-1", suffixe = "-2", suffixe = "-3"...),
alors il te faut dresser dans un tableau suffixes( ) une liste exhaustive des suffixes utilisés pour tes image.
Dans le code ci-dessous, et pour chaque racine de la colonne A de ta feuille de calcul, la procédure j_espere_que_ca_marche() balaie le tableau suffixes() et recherche l'image racine & suffixe(n) dans l'arborescence. Elle affiche les images trouvées de gauche à droite à partir de la colonne B, en ajustant la hauteur et la largeur de chaque colonne. J'espère être assez clair.
Sub j_espere_que_ca_marche()
Dim i As Integer, path As String, sep As String, img As String
Dim racine as string, suffixes as variant, colonne as integer
Dim j as integer
suffixes = array("","-1","-2"...) ' dresser une liste exhaustive des suffixes sep = Application.PathSeparator
path = ActiveWorkbook.path & sep & "images" & sep
For i = 1 To 700
racine = cells(i, 1).value
colonne = 1
largeMax = 0
for j = 0 to ubound(suffixes)
img = racine & suffixes(j)
img = recurseChercheFichier(path, img)
if img <> "" then
colonne = colonne + 1
if Selection.Height + 10 > Rows(i).RowHeight then _
Rows(i).RowHeight = Selection.Height + 10
if Selection.Width > Rows(i).RowWidth then _
Rows(i).RowWidth = Selection.Width
ActiveSheet.Pictures.Insert(img).Select
Selection.Top = Cells(i, colonne).Top
Selection.Left = Cells(i, colonne).Lef
DoEvents endif
Next
Next
End Sub
J'ai compilé ce code pour m'assurer qu'il n'avait pas d'erreur, mais je n'ai pas pu le faire tourner puisque je n'ai
pas le jeu d'essai de fichiers qui va bien. Il devrait être plus gourmand en temps machine que le précédent, c'est pourquoi j'ai mis un DoEvents pour que tu puisses avoir la main pendant qu'il travaille.
Une recherche à partir du caractère générique * est possible mais je l'exclus, car la modification de la procédure recurseChercheFichier pour la rendre récursive à la fois sur l'arborescence et sur la racine ferait d'elle une vraie usine à gaz et me cataloguerait dans la catégorie bidouilleurs.