Nom et première lettre du prénom

Le
kerr2
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
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
phil
Le #3804731
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" 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
Le #3804571
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" 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" 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
Le #3803761
Salut
Content d'avoir pu t'aider !
@+Phil

"kerr2" 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" 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" 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













Publicité
Poster une réponse
Anonyme