Je réalise un trombinoscope.
En VBA j'insère automatiquement les photos des élèves dont le nom et prénom
sont en
A2: Nom
B2: Prénom
C2: Photo à importer
S' il existe une photo intitulée:
Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même nom
de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg
(P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg
je test s'il existe une photo intitulée:
Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve
pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "\Photos " & NomOnglet & "\" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
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
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
phil
Salut est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le nom de fichier que tu veux (problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas en extension .jpg (qui est plus courant !)
@+Phil
"kerr2" a écrit dans le message de news: uQUZy9$
Bonjour,
Je réalise un trombinoscope. En VBA j'insère automatiquement les photos des élèves dont le nom et prénom sont en A2: Nom B2: Prénom C2: Photo à importer
S' il existe une photo intitulée: Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg (P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg je test s'il existe une photo intitulée: Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep() ActiveSheet.Pictures.Delete ChDir ActiveWorkbook.Path NomOnglet = ActiveSheet.Name sousRep = "Photos " & NomOnglet & "" ' nom du sous rep" chemin = ActiveWorkbook.Path & sousRep nf = Dir("*.jpg") ' premier fichier nf1 = Dir("*.jpg") 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 Else nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If End If ActiveCell.Offset(1, 0).Select Loop End Sub
Salut
est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le nom
de fichier que tu veux
(problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas en
extension .jpg (qui est plus courant !)
@+Phil
"kerr2" <kerr2entrop@free.onsupprimefr> a écrit dans le message de news:
uQUZy9$qGHA.4112@TK2MSFTNGP02.phx.gbl...
Bonjour,
Je réalise un trombinoscope.
En VBA j'insère automatiquement les photos des élèves dont le nom et
prénom sont en
A2: Nom
B2: Prénom
C2: Photo à importer
S' il existe une photo intitulée:
Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même
nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg
(P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg
je test s'il existe une photo intitulée:
Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve
pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
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
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Salut est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le nom de fichier que tu veux (problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas en extension .jpg (qui est plus courant !)
@+Phil
"kerr2" a écrit dans le message de news: uQUZy9$
Bonjour,
Je réalise un trombinoscope. En VBA j'insère automatiquement les photos des élèves dont le nom et prénom sont en A2: Nom B2: Prénom C2: Photo à importer
S' il existe une photo intitulée: Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg (P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg je test s'il existe une photo intitulée: Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep() ActiveSheet.Pictures.Delete ChDir ActiveWorkbook.Path NomOnglet = ActiveSheet.Name sousRep = "Photos " & NomOnglet & "" ' nom du sous rep" chemin = ActiveWorkbook.Path & sousRep nf = Dir("*.jpg") ' premier fichier nf1 = Dir("*.jpg") 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 Else nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If End If ActiveCell.Offset(1, 0).Select Loop End Sub
kerr2
Bonjour phil, Merci pour ton aide. Cela fonctionne maintenant.
Pour répondre a tes questions. Oui cela fonctionnait avec le nom seul.
J'ai employé par erreur jpeg pour nf1 (alors que pour nf j'utilisais bien jpg).
Bonne soirée.
"phil" a écrit dans le message de news: 44bf940c$0$18108$
Salut est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le nom de fichier que tu veux (problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas en extension .jpg (qui est plus courant !)
@+Phil
"kerr2" a écrit dans le message de news: uQUZy9$
Bonjour,
Je réalise un trombinoscope. En VBA j'insère automatiquement les photos des élèves dont le nom et prénom sont en A2: Nom B2: Prénom C2: Photo à importer
S' il existe une photo intitulée: Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg (P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg je test s'il existe une photo intitulée: Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep() ActiveSheet.Pictures.Delete ChDir ActiveWorkbook.Path NomOnglet = ActiveSheet.Name sousRep = "Photos " & NomOnglet & "" ' nom du sous rep" chemin = ActiveWorkbook.Path & sousRep nf = Dir("*.jpg") ' premier fichier nf1 = Dir("*.jpg") 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 Else nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If End If ActiveCell.Offset(1, 0).Select Loop End Sub
Bonjour phil,
Merci pour ton aide. Cela fonctionne maintenant.
Pour répondre a tes questions.
Oui cela fonctionnait avec le nom seul.
J'ai employé par erreur jpeg pour nf1 (alors que pour nf j'utilisais bien
jpg).
Bonne soirée.
"phil" <nospam.philippe.leduc@free.fr> a écrit dans le message de news:
44bf940c$0$18108$636a55ce@news.free.fr...
Salut
est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le
nom de fichier que tu veux
(problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas
en extension .jpg (qui est plus courant !)
@+Phil
"kerr2" <kerr2entrop@free.onsupprimefr> a écrit dans le message de news:
uQUZy9$qGHA.4112@TK2MSFTNGP02.phx.gbl...
Bonjour,
Je réalise un trombinoscope.
En VBA j'insère automatiquement les photos des élèves dont le nom et
prénom sont en
A2: Nom
B2: Prénom
C2: Photo à importer
S' il existe une photo intitulée:
Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même
nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg
(P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg
je test s'il existe une photo intitulée:
Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve
pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
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
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Bonjour phil, Merci pour ton aide. Cela fonctionne maintenant.
Pour répondre a tes questions. Oui cela fonctionnait avec le nom seul.
J'ai employé par erreur jpeg pour nf1 (alors que pour nf j'utilisais bien jpg).
Bonne soirée.
"phil" a écrit dans le message de news: 44bf940c$0$18108$
Salut est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le nom de fichier que tu veux (problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas en extension .jpg (qui est plus courant !)
@+Phil
"kerr2" a écrit dans le message de news: uQUZy9$
Bonjour,
Je réalise un trombinoscope. En VBA j'insère automatiquement les photos des élèves dont le nom et prénom sont en A2: Nom B2: Prénom C2: Photo à importer
S' il existe une photo intitulée: Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg (P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg je test s'il existe une photo intitulée: Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep() ActiveSheet.Pictures.Delete ChDir ActiveWorkbook.Path NomOnglet = ActiveSheet.Name sousRep = "Photos " & NomOnglet & "" ' nom du sous rep" chemin = ActiveWorkbook.Path & sousRep nf = Dir("*.jpg") ' premier fichier nf1 = Dir("*.jpg") 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 Else nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If End If ActiveCell.Offset(1, 0).Select Loop End Sub
bret17
Salut Content d'avoir pu t'aider ! @+Phil
"kerr2" a écrit dans le message de news:%
Bonjour phil, Merci pour ton aide. Cela fonctionne maintenant.
Pour répondre a tes questions. Oui cela fonctionnait avec le nom seul.
J'ai employé par erreur jpeg pour nf1 (alors que pour nf j'utilisais bien jpg).
Bonne soirée.
"phil" a écrit dans le message de news: 44bf940c$0$18108$
Salut est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le nom de fichier que tu veux (problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas en extension .jpg (qui est plus courant !)
@+Phil
"kerr2" a écrit dans le message de news: uQUZy9$
Bonjour,
Je réalise un trombinoscope. En VBA j'insère automatiquement les photos des élèves dont le nom et prénom sont en A2: Nom B2: Prénom C2: Photo à importer
S' il existe une photo intitulée: Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même
nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg (P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg je test s'il existe une photo intitulée: Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve
pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep() ActiveSheet.Pictures.Delete ChDir ActiveWorkbook.Path NomOnglet = ActiveSheet.Name sousRep = "Photos " & NomOnglet & "" ' nom du sous rep" chemin = ActiveWorkbook.Path & sousRep nf = Dir("*.jpg") ' premier fichier nf1 = Dir("*.jpg") 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 Else nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If End If ActiveCell.Offset(1, 0).Select Loop End Sub
Salut
Content d'avoir pu t'aider !
@+Phil
"kerr2" <kerr2entrop@free.onsupprimefr> a écrit dans le message de
news:%23DXZ4zBrGHA.4680@TK2MSFTNGP02.phx.gbl...
Bonjour phil,
Merci pour ton aide. Cela fonctionne maintenant.
Pour répondre a tes questions.
Oui cela fonctionnait avec le nom seul.
J'ai employé par erreur jpeg pour nf1 (alors que pour nf j'utilisais bien
jpg).
Bonne soirée.
"phil" <nospam.philippe.leduc@free.fr> a écrit dans le message de news:
44bf940c$0$18108$636a55ce@news.free.fr...
Salut
est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le
nom de fichier que tu veux
(problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas
en extension .jpg (qui est plus courant !)
@+Phil
"kerr2" <kerr2entrop@free.onsupprimefr> a écrit dans le message de news:
uQUZy9$qGHA.4112@TK2MSFTNGP02.phx.gbl...
Bonjour,
Je réalise un trombinoscope.
En VBA j'insère automatiquement les photos des élèves dont le nom et
prénom sont en
A2: Nom
B2: Prénom
C2: Photo à importer
S' il existe une photo intitulée:
Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le
même
nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg
(P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg
je test s'il existe une photo intitulée:
Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne
trouve
pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep()
ActiveSheet.Pictures.Delete
ChDir ActiveWorkbook.Path
NomOnglet = ActiveSheet.Name
sousRep = "Photos " & NomOnglet & "" ' nom du sous rep"
chemin = ActiveWorkbook.Path & sousRep
nf = Dir("*.jpg") ' premier fichier
nf1 = Dir("*.jpg")
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
Else
nf1 = ActiveCell.Offset(0, -2).Value & " " &
Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg"
If Dir(chemin & nf1) <> "" Then
Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1)
ActiveCell.EntireRow.RowHeight = monimage.Height + 0
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Bonjour phil, Merci pour ton aide. Cela fonctionne maintenant.
Pour répondre a tes questions. Oui cela fonctionnait avec le nom seul.
J'ai employé par erreur jpeg pour nf1 (alors que pour nf j'utilisais bien jpg).
Bonne soirée.
"phil" a écrit dans le message de news: 44bf940c$0$18108$
Salut est-ce que ça marche avec le nom seul (sans la 1ère lettre du prénom) ?
Sinon en debogage vérifie ce que donne chemin & nf1 si ça donne bien le nom de fichier que tu veux (problème de majsucule à voir par exemple)
Dernière chose es-tu sur que tes fichiers sont en extension .jpeg et pas en extension .jpg (qui est plus courant !)
@+Phil
"kerr2" a écrit dans le message de news: uQUZy9$
Bonjour,
Je réalise un trombinoscope. En VBA j'insère automatiquement les photos des élèves dont le nom et prénom sont en A2: Nom B2: Prénom C2: Photo à importer
S' il existe une photo intitulée: Nom.jpeg => l'import de la photo en C2 fonctionne
J'essaie maintenant de résoudre le problème ou 2 élèves auraient le même
nom de famille. Dans ce cas je nomme la photo scannée Nom P.jpeg (P représente la première lettre du Prénom)
S'il n'existe pas de photo Nom.jpeg je test s'il existe une photo intitulée: Nom + " " + 1ère lettre du prénom.jpeg
En mode débogage je m'apperçois que le programme que j'ai écrit ne trouve
pas la photo et saute directement à End If
nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If
Voila.
Si quelqu'un peut m'éclairer .
En vous remerciant par avance.
Le code complet ci-dessous
Sub ImportImagesSousRep() ActiveSheet.Pictures.Delete ChDir ActiveWorkbook.Path NomOnglet = ActiveSheet.Name sousRep = "Photos " & NomOnglet & "" ' nom du sous rep" chemin = ActiveWorkbook.Path & sousRep nf = Dir("*.jpg") ' premier fichier nf1 = Dir("*.jpg") 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 Else nf1 = ActiveCell.Offset(0, -2).Value & " " & Left(ActiveCell.Offset(0, -1).Value, 1) & ".jpeg" If Dir(chemin & nf1) <> "" Then Set monimage = ActiveSheet.Pictures.Insert(chemin & nf1) ActiveCell.EntireRow.RowHeight = monimage.Height + 0 End If End If ActiveCell.Offset(1, 0).Select Loop End Sub
