Chercher les photos dans le bon sous dossier

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des classes
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro suivan te
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photos dans les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feuille o u la
macro est executée.

Pas facile

En vous remerciant par avance.

Bonsoir JB,

Je te remercie pour ton aide. J'ai ajouté le test si pas d'image que tu as
indiqués dans le fil "Test si pas photo"
En mode pas à pas on ne rempli pas la condition If Dir(nf) <> "" Then
La macro ne trouve pas les photos.
Pourtant je respecte bien une arborescence du type
D:Trombinoscope2006-2007Trombinoscope BEP.xls
D:Trombinoscope2006-20072-1 pour les photos de la feuille 2-1

En fait le dossier des photos est
D:Trombinoscope2006-2007Photos 2-1

Mais comme j'ai oublié de le préciser j'ai adapté
Mais si c'est possble de prendre en compte le dossier sous la forme Photos
espace +"nom de l'onglet" je suis preneur

En te remerciant par avance

----------------------------------------
Sub ImportImages()
ChDir ActiveWorkbook.Path
sousRep = "BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(0, 2).Select
Loop
End Sub

----------------------------------------------



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152643260.846681.269140@s13g2000cwa.googlegroups.com...

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des classes
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro
suivante
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photos dans les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feuille ou la
macro est executée.

Pas facile

En vous remerciant par avance.

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2_1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonsoir JB,

Je te remercie pour ton aide. J'ai ajouté le test si pas d'image que tu as
indiqués dans le fil "Test si pas photo"
En mode pas à pas on ne rempli pas la condition If Dir(nf) <> "" Then
La macro ne trouve pas les photos.
Pourtant je respecte bien une arborescence du type
D:Trombinoscope2006-2007Trombinoscope BEP.xls
D:Trombinoscope2006-20072-1 pour les photos de la feuille 2-1

En fait le dossier des photos est
D:Trombinoscope2006-2007Photos 2-1

Mais comme j'ai oublié de le préciser j'ai adapté
Mais si c'est possble de prendre en compte le dossier sous la forme Pho tos
espace +"nom de l'onglet" je suis preneur

En te remerciant par avance

----------------------------------------
Sub ImportImages()
ChDir ActiveWorkbook.Path
sousRep = "BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(0, 2).Select
Loop
End Sub

----------------------------------------------



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152643260.846681.269140@s13g2000cwa.googlegroups.com...

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des class es
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro
suivante
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photos da ns les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feuille ou la
macro est executée.

Pas facile

En vous remerciant par avance.

Bonsoir JB
Merci pour ton aide cela avance.
Encore un petit quelque chose à régler. (Pour la suite dans ton code j'ai
modifié le 2_1 en 2-1)

Je résume si j'ai :
D:Trombinoscope BEP.xls
D:2-1 répertoire contenant les photos de la feuille 2-1

La macro remplie la condition
If Dir(chemin & nf) <> "" Then
mais bute sur
Set monimage = ActiveSheet.Pictures.Insert(nf)

message => Impossible de lire la propriété Insert de la classe Pictures.

(1) Si je mets maintenant quelque photos du dossier 2-1 dans D:
cela fonctionne.

(2) Si je nomme le répertoire ou je mets les photos
D:2_1 au lieu de D:2-1
la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope.

(3) Si je modifie la ligne
sousRep = "Photos " & onglet & "" ' nom du sous rep"
en
sousRep = "Photos " & onglet ' nom du sous rep"
comme pour le (2) la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope


Merci pour l'aide que tu apportes.





Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub


"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152680674.059896.308110@75g2000cwc.googlegroups.com...

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2_1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonsoir JB,

Je te remercie pour ton aide. J'ai ajouté le test si pas d'image que tu
as
indiqués dans le fil "Test si pas photo"
En mode pas à pas on ne rempli pas la condition If Dir(nf) <> "" Then
La macro ne trouve pas les photos.
Pourtant je respecte bien une arborescence du type
D:Trombinoscope2006-2007Trombinoscope BEP.xls
D:Trombinoscope2006-20072-1 pour les photos de la feuille 2-1

En fait le dossier des photos est
D:Trombinoscope2006-2007Photos 2-1

Mais comme j'ai oublié de le préciser j'ai adapté
Mais si c'est possble de prendre en compte le dossier sous la forme
Photos
espace +"nom de l'onglet" je suis preneur

En te remerciant par avance

----------------------------------------
Sub ImportImages()
ChDir ActiveWorkbook.Path
sousRep = "BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(0, 2).Select
Loop
End Sub

----------------------------------------------



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152643260.846681.269140@s13g2000cwa.googlegroups.com...

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des classes
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro
suivante
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photos dans
les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feuille ou la
macro est executée.

Pas facile

En vous remerciant par avance.

Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)

JB

Bonsoir JB
Merci pour ton aide cela avance.
Encore un petit quelque chose à régler. (Pour la suite dans ton code j'ai
modifié le 2_1 en 2-1)

Je résume si j'ai :
D:Trombinoscope BEP.xls
D:2-1 répertoire contenant les photos de la feuille 2-1

La macro remplie la condition
If Dir(chemin & nf) <> "" Then
mais bute sur
Set monimage = ActiveSheet.Pictures.Insert(nf)

message => Impossible de lire la propriété Insert de la classe Pict ures.

(1) Si je mets maintenant quelque photos du dossier 2-1 dans D:
cela fonctionne.

(2) Si je nomme le répertoire ou je mets les photos
D:2_1 au lieu de D:2-1
la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope.

(3) Si je modifie la ligne
sousRep = "Photos " & onglet & "" ' nom du sous rep"
en
sousRep = "Photos " & onglet ' nom du sous rep"
comme pour le (2) la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope


Merci pour l'aide que tu apportes.





Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub


"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152680674.059896.308110@75g2000cwc.googlegroups.com...

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2_1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonsoir JB,

Je te remercie pour ton aide. J'ai ajouté le test si pas d'image qu e tu
as
indiqués dans le fil "Test si pas photo"
En mode pas à pas on ne rempli pas la condition If Dir(nf) <> "" Then
La macro ne trouve pas les photos.
Pourtant je respecte bien une arborescence du type
D:Trombinoscope2006-2007Trombinoscope BEP.xls
D:Trombinoscope2006-20072-1 pour les photos de la feuille 2-1

En fait le dossier des photos est
D:Trombinoscope2006-2007Photos 2-1

Mais comme j'ai oublié de le préciser j'ai adapté
Mais si c'est possble de prendre en compte le dossier sous la forme
Photos
espace +"nom de l'onglet" je suis preneur

En te remerciant par avance

----------------------------------------
Sub ImportImages()
ChDir ActiveWorkbook.Path
sousRep = "BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(0, 2).Select
Loop
End Sub

----------------------------------------------



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152643260.846681.269140@s13g2000cwa.googlegroups.com...

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des cla sses
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro
suivante
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photos dans
les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feuil le ou la
macro est executée.

Pas facile

En vous remerciant par avance.

Bonjour JB,

Et bien cela fonctionne. Je te remercie beaucoup.
J'essaie donc d'avancer encore un petit peu.

Au lieu de mettre
onglet = "2-1" est il possible de mettre
onglet = la valeur récupérée dans l'onglet de la feuille. (Ainsi la macro
fonctionnera dans toute les feuilles.)

qq chose comme cela en VBA
onglet =
STXT(CELLULE("filename";A1);TROUVE("]";CELLULE("filename";A1))+1;32)


J'ai essayé cela, mais cela ne va pas.
onglet = Application.Caller.Parent.Name


Si tu peux encore m'aider.

En te remerciant par avance.




Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152757744.488902.289160@b28g2000cwb.googlegroups.com...
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)

JB

Bonsoir JB
Merci pour ton aide cela avance.
Encore un petit quelque chose à régler. (Pour la suite dans ton code j'ai
modifié le 2_1 en 2-1)

Je résume si j'ai :
D:Trombinoscope BEP.xls
D:2-1 répertoire contenant les photos de la feuille 2-1

La macro remplie la condition
If Dir(chemin & nf) <> "" Then
mais bute sur
Set monimage = ActiveSheet.Pictures.Insert(nf)

message => Impossible de lire la propriété Insert de la classe Pictures.

(1) Si je mets maintenant quelque photos du dossier 2-1 dans D:
cela fonctionne.

(2) Si je nomme le répertoire ou je mets les photos
D:2_1 au lieu de D:2-1
la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope.

(3) Si je modifie la ligne
sousRep = "Photos " & onglet & "" ' nom du sous rep"
en
sousRep = "Photos " & onglet ' nom du sous rep"
comme pour le (2) la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope


Merci pour l'aide que tu apportes.





Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub


"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152680674.059896.308110@75g2000cwc.googlegroups.com...

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2_1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonsoir JB,

Je te remercie pour ton aide. J'ai ajouté le test si pas d'image que
tu
as
indiqués dans le fil "Test si pas photo"
En mode pas à pas on ne rempli pas la condition If Dir(nf) <> "" Then
La macro ne trouve pas les photos.
Pourtant je respecte bien une arborescence du type
D:Trombinoscope2006-2007Trombinoscope BEP.xls
D:Trombinoscope2006-20072-1 pour les photos de la feuille 2-1

En fait le dossier des photos est
D:Trombinoscope2006-2007Photos 2-1

Mais comme j'ai oublié de le préciser j'ai adapté
Mais si c'est possble de prendre en compte le dossier sous la forme
Photos
espace +"nom de l'onglet" je suis preneur

En te remerciant par avance

----------------------------------------
Sub ImportImages()
ChDir ActiveWorkbook.Path
sousRep = "BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(0, 2).Select
Loop
End Sub

----------------------------------------------



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152643260.846681.269140@s13g2000cwa.googlegroups.com...

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des classes
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro
suivante
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photos dans
les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feuille ou
la
macro est executée.

Pas facile

En vous remerciant par avance.

onglet = ActiveSheet.Name
(si la macro est bien lancée à partir de l'onglet)

JB

Bonjour JB,

Et bien cela fonctionne. Je te remercie beaucoup.
J'essaie donc d'avancer encore un petit peu.

Au lieu de mettre
onglet = "2-1" est il possible de mettre
onglet = la valeur récupérée dans l'onglet de la feuille. (Ainsi la macro
fonctionnera dans toute les feuilles.)

qq chose comme cela en VBA
onglet =
STXT(CELLULE("filename";A1);TROUVE("]";CELLULE("filename";A1))+1;32)


J'ai essayé cela, mais cela ne va pas.
onglet = Application.Caller.Parent.Name


Si tu peux encore m'aider.

En te remerciant par avance.




Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152757744.488902.289160@b28g2000cwb.googlegroups.com...
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)

JB

Bonsoir JB
Merci pour ton aide cela avance.
Encore un petit quelque chose à régler. (Pour la suite dans ton cod e j'ai
modifié le 2_1 en 2-1)

Je résume si j'ai :
D:Trombinoscope BEP.xls
D:2-1 répertoire contenant les photos de la feuille 2-1

La macro remplie la condition
If Dir(chemin & nf) <> "" Then
mais bute sur
Set monimage = ActiveSheet.Pictures.Insert(nf)

message => Impossible de lire la propriété Insert de la classe Pi ctures.

(1) Si je mets maintenant quelque photos du dossier 2-1 dans D:
cela fonctionne.

(2) Si je nomme le répertoire ou je mets les photos
D:2_1 au lieu de D:2-1
la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope.

(3) Si je modifie la ligne
sousRep = "Photos " & onglet & "" ' nom du sous rep"
en
sousRep = "Photos " & onglet ' nom du sous rep"
comme pour le (2) la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope


Merci pour l'aide que tu apportes.





Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub


"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152680674.059896.308110@75g2000cwc.googlegroups.com...

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2_1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonsoir JB,

Je te remercie pour ton aide. J'ai ajouté le test si pas d'image que
tu
as
indiqués dans le fil "Test si pas photo"
En mode pas à pas on ne rempli pas la condition If Dir(nf) <> "" T hen
La macro ne trouve pas les photos.
Pourtant je respecte bien une arborescence du type
D:Trombinoscope2006-2007Trombinoscope BEP.xls
D:Trombinoscope2006-20072-1 pour les photos de la feuille 2-1

En fait le dossier des photos est
D:Trombinoscope2006-2007Photos 2-1

Mais comme j'ai oublié de le préciser j'ai adapté
Mais si c'est possble de prendre en compte le dossier sous la forme
Photos
espace +"nom de l'onglet" je suis preneur

En te remerciant par avance

----------------------------------------
Sub ImportImages()
ChDir ActiveWorkbook.Path
sousRep = "BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(0, 2).Select
Loop
End Sub

----------------------------------------------



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152643260.846681.269140@s13g2000cwa.googlegroups.com...

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des c lasses
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro
suivante
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photo s dans
les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feu ille ou
la
macro est executée.

Pas facile

En vous remerciant par avance.

Merci JB,
Cela fonctionne maintenant tres bien pour chaques feuilles du classeur.

Se présente maintenant le cas ou 2 personnes ont le même nom de famille.
Quand je scanne les photos dans ce cas je mets la première lettre du prénom
(mais seulement dans ce cas pour gain de temps)

A2: NOM
B2: Prénom
C2 => nom de la photo à insérer NOM P.jpeg


Je voudrai donc réaliser un test dans le cas ou le test ne trouve pas de
photo correspondant à la cellule A2 de tester et insérer si il y a une photo
comportant le nom (A2) + 1ère lettre du prénom (extraire la première lettre
de B2) + .jpeg
ex:

A2: DUPONT
B2: Paul
C2 => nom de la photo à insérer DUPONT P.jpeg

Mais si il y a une photo comportant juste le nom DUPONT il faut continuer à
l'insérer. Cela veut donc dire qu'il n'y a qu'une personne de nom DUPONT

Merci encore si tu peux m'aider.

J'ai modifié le code que tu as donné pour maintenant prendre en compte le
prénom en A2 et la photo en C2

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("c2").Select
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub











"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152803372.784291.29830@35g2000cwc.googlegroups.com...
onglet = ActiveSheet.Name
(si la macro est bien lancée à partir de l'onglet)

JB

Bonjour JB,

Et bien cela fonctionne. Je te remercie beaucoup.
J'essaie donc d'avancer encore un petit peu.

Au lieu de mettre
onglet = "2-1" est il possible de mettre
onglet = la valeur récupérée dans l'onglet de la feuille. (Ainsi la macro
fonctionnera dans toute les feuilles.)

qq chose comme cela en VBA
onglet > STXT(CELLULE("filename";A1);TROUVE("]";CELLULE("filename";A1))+1;32)


J'ai essayé cela, mais cela ne va pas.
onglet = Application.Caller.Parent.Name


Si tu peux encore m'aider.

En te remerciant par avance.




Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152757744.488902.289160@b28g2000cwb.googlegroups.com...
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)

JB

Bonsoir JB
Merci pour ton aide cela avance.
Encore un petit quelque chose à régler. (Pour la suite dans ton code
j'ai
modifié le 2_1 en 2-1)

Je résume si j'ai :
D:Trombinoscope BEP.xls
D:2-1 répertoire contenant les photos de la feuille 2-1

La macro remplie la condition
If Dir(chemin & nf) <> "" Then
mais bute sur
Set monimage = ActiveSheet.Pictures.Insert(nf)

message => Impossible de lire la propriété Insert de la classe Pictures.

(1) Si je mets maintenant quelque photos du dossier 2-1 dans D:
cela fonctionne.

(2) Si je nomme le répertoire ou je mets les photos
D:2_1 au lieu de D:2-1
la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope.

(3) Si je modifie la ligne
sousRep = "Photos " & onglet & "" ' nom du sous rep"
en
sousRep = "Photos " & onglet ' nom du sous rep"
comme pour le (2) la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope


Merci pour l'aide que tu apportes.





Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub


"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152680674.059896.308110@75g2000cwc.googlegroups.com...

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2_1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonsoir JB,

Je te remercie pour ton aide. J'ai ajouté le test si pas d'image que
tu
as
indiqués dans le fil "Test si pas photo"
En mode pas à pas on ne rempli pas la condition If Dir(nf) <> "" Then
La macro ne trouve pas les photos.
Pourtant je respecte bien une arborescence du type
D:Trombinoscope2006-2007Trombinoscope BEP.xls
D:Trombinoscope2006-20072-1 pour les photos de la feuille 2-1

En fait le dossier des photos est
D:Trombinoscope2006-2007Photos 2-1

Mais comme j'ai oublié de le préciser j'ai adapté
Mais si c'est possble de prendre en compte le dossier sous la forme
Photos
espace +"nom de l'onglet" je suis preneur

En te remerciant par avance

----------------------------------------
Sub ImportImages()
ChDir ActiveWorkbook.Path
sousRep = "BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(0, 2).Select
Loop
End Sub

----------------------------------------------



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152643260.846681.269140@s13g2000cwa.googlegroups.com...

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des
classes
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro
suivante
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photos
dans
les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feuille ou
la
macro est executée.

Pas facile

En vous remerciant par avance.

Merci JB,
Cela fonctionne maintenant tres bien pour chaques feuilles du classeur.

Se présente maintenant le cas ou 2 personnes ont le même nom de famille.
Quand je scanne les photos dans ce cas je mets la première lettre du prénom
(mais seulement dans ce cas pour gain de temps)

A2: NOM
B2: Prénom
C2 => nom de la photo à insérer NOM P.jpeg


Je voudrai donc réaliser un test dans le cas ou le test ne trouve pas de
photo correspondant à la cellule A2 de tester et insérer si il y a une photo
comportant le nom (A2) + 1ère lettre du prénom (extraire la première lettre
de B2) + .jpeg
ex:

A2: DUPONT
B2: Paul
C2 => nom de la photo à insérer DUPONT P.jpeg

Mais si il y a une photo comportant juste le nom DUPONT il faut continuer à
l'insérer. Cela veut donc dire qu'il n'y a qu'une personne de nom DUPONT

Merci encore si tu peux m'aider.

J'ai modifié le code que tu as donné pour maintenant prendre en compte le
prénom en B2 et la photo en C2

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("c2").Select
Do While ActiveCell.Offset(0, -2).Value <> ""
nf = ActiveCell.Offset(0, -2).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub


"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152803372.784291.29830@35g2000cwc.googlegroups.com...
onglet = ActiveSheet.Name
(si la macro est bien lancée à partir de l'onglet)

JB

Bonjour JB,

Et bien cela fonctionne. Je te remercie beaucoup.
J'essaie donc d'avancer encore un petit peu.

Au lieu de mettre
onglet = "2-1" est il possible de mettre
onglet = la valeur récupérée dans l'onglet de la feuille. (Ainsi la macro
fonctionnera dans toute les feuilles.)

qq chose comme cela en VBA
onglet > STXT(CELLULE("filename";A1);TROUVE("]";CELLULE("filename";A1))+1;32)


J'ai essayé cela, mais cela ne va pas.
onglet = Application.Caller.Parent.Name


Si tu peux encore m'aider.

En te remerciant par avance.




Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152757744.488902.289160@b28g2000cwb.googlegroups.com...
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)

JB

Bonsoir JB
Merci pour ton aide cela avance.
Encore un petit quelque chose à régler. (Pour la suite dans ton code
j'ai
modifié le 2_1 en 2-1)

Je résume si j'ai :
D:Trombinoscope BEP.xls
D:2-1 répertoire contenant les photos de la feuille 2-1

La macro remplie la condition
If Dir(chemin & nf) <> "" Then
mais bute sur
Set monimage = ActiveSheet.Pictures.Insert(nf)

message => Impossible de lire la propriété Insert de la classe Pictures.

(1) Si je mets maintenant quelque photos du dossier 2-1 dans D:
cela fonctionne.

(2) Si je nomme le répertoire ou je mets les photos
D:2_1 au lieu de D:2-1
la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope.

(3) Si je modifie la ligne
sousRep = "Photos " & onglet & "" ' nom du sous rep"
en
sousRep = "Photos " & onglet ' nom du sous rep"
comme pour le (2) la macro ne remplie pas la condition
If Dir(chemin & nf) <> "" Then
pas de message d'erreur mais aussi pas de photos sur le trombinoscope


Merci pour l'aide que tu apportes.





Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2-1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub


"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152680674.059896.308110@75g2000cwc.googlegroups.com...

Sub ImportImagesSousRep()
ChDir ActiveWorkbook.Path
onglet = "2_1"
sousRep = "Photos " & onglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1).Value <> ""
nf = ActiveCell.Offset(0, -1).Value & ".jpg"
If Dir(chemin & nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonsoir JB,

Je te remercie pour ton aide. J'ai ajouté le test si pas d'image que
tu
as
indiqués dans le fil "Test si pas photo"
En mode pas à pas on ne rempli pas la condition If Dir(nf) <> "" Then
La macro ne trouve pas les photos.
Pourtant je respecte bien une arborescence du type
D:Trombinoscope2006-2007Trombinoscope BEP.xls
D:Trombinoscope2006-20072-1 pour les photos de la feuille 2-1

En fait le dossier des photos est
D:Trombinoscope2006-2007Photos 2-1

Mais comme j'ai oublié de le préciser j'ai adapté
Mais si c'est possble de prendre en compte le dossier sous la forme
Photos
espace +"nom de l'onglet" je suis preneur

En te remerciant par avance

----------------------------------------
Sub ImportImages()
ChDir ActiveWorkbook.Path
sousRep = "BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(0, 2).Select
Loop
End Sub

----------------------------------------------



"JB" <boisgontier@hotmail.com> a écrit dans le message de news:
1152643260.846681.269140@s13g2000cwa.googlegroups.com...

Sub ImportImages2()
ChDir ActiveWorkbook.Path
sousRep="BD"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
Range("b2").Select
Do While ActiveCell.Offset(0, -1) <> ""
nf = ActiveCell.Offset(0, -1) & ".jpg"
If Dir(nf) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub

JB

Bonjour,

J'ai un fichier qui se trouve =>
D:Trombinoscope2006-2007Trombinoscope BEP.xls
Ce classeur comporte différentes feuilles correspondant à des
classes
d'école: 2-1 , 2-2, 2-3, etc.

J'ai également des sous dossiers contenant des photos:
D:Trombinoscope2006-20072-1
D:Trombinoscope2006-20072-2
D:Trombinoscope2006-20072-3
etc.

Dans Trombinoscope BEP.xls sur chaque feuille j'utilise la macro
suivante
pour ajouter les photos.

Sub ImportImages()
ChDir ActiveWorkbook.Path
Range("a7").Select
Do While ActiveCell.Offset(2, 0).Value <> ""
nf = ActiveCell.Offset(2, 0).Value & ".jpg"
Set monimage = ActiveSheet.Pictures.Insert(nf)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
ActiveCell.Offset(0, 2).Select
Loop

Pourriez vous m'aider a ce que cette macro récupère les photos
dans
les
répertoire correspondant.
Les photos seront toujours dans un sous répertoire
Le nom du répertoire est récupérable dans l'onglet de la feuille ou
la
macro est executée.

Pas facile

En vous remerciant par avance.