XL 2013 Insertion Plusieurs photos vba

[anismegrine]

Bonjour à tous,

je reviens vers vous pour un coup de main en VBA.
j'ai un dossier contenant des photos jpg le nom de chaque photo est le matricule d'un employé
je veux insérer toutes les photos dans une feuille excel de façon à ce que dans la colonne A j’insère le matricule et dans la colonne B l'image (le nom de l'image doit être le matricule suivi par un p par exemple 952p)
depuis hier je bloque sur la première partie l'insertion d'une image.

Sub insertion()
Dim chem, matricule , photo
chem = "C:\photo du personnel\Nouveau dossier\"
For Each matricule In [Feuil1!G1:G435]
If matricule.Value <> "" Then
photo = matricule & chem & ".jpg"
ActiveSheet.Pictures.insert(photo.Value).Select
End If
Next
End Sub

merci pour votre aide

 

[job75]

Re : Insertion Plusieurs photos vba

Bonjour anismegrine,

Essayez et adaptez si nécessaire :

Sub ImportPhotos()
Dim chemin$, fich$
chemin = "C:\photo du personnel\Nouveau dossier\"
fich = Dir(chemin & "*.jpg")
[B1].Select
ActiveSheet.Pictures.Delete 'RAZ
While fich <> ""
  ActiveCell(2).Select
  ActiveCell(1, 0) = Left(fich, Len(fich) - 4) 'matricule
  ActiveCell.RowHeight = ActiveSheet.Pictures.Insert(chemin & fich).Height
  fich = Dir
Wend
End Sub

A+

 

[job75]

Re : Insertion Plusieurs photos vba

Annulé.

J'essayais un tri alphanumérique mais les images ne suivent pas.

 

[job75]

Re : Insertion Plusieurs photos vba

Re,

Voici la bonne macro pour effectuer un tri sur les matricules :

Sub ImportPhotos()
Dim chemin$, fich$, i&
chemin = "C:\photo du personnel\Nouveau dossier\" 'ThisWorkbook.Path & "\" 'pour tester
fich = Dir(chemin & "*.jpg")
Application.ScreenUpdating = False
ActiveSheet.Pictures.Delete 'RAZ
Range("A2:B" & Rows.Count).ClearContents
i = 1
While fich <> ""
  i = i + 1
  Cells(i, 1) = Left(fich, Len(fich) - 4) 'matricule
  Cells(i, 2) = ActiveSheet.Pictures.Insert(chemin & fich).Name
  fich = Dir
Wend
[A:B].Sort [A1], xlAscending, Header:=xlYes 'tri sur les matricules
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
  With ActiveSheet.Pictures(CStr(Cells(i, 2)))
    Rows(i).RowHeight = .Height
    .Top = Cells(i, 2).Top
    .Left = Cells(i, 2).Left
  End With
Next
End Sub

Bonne fin de soirée.

 

[anismegrine]

Re : Insertion Plusieurs photos vba

ça marche Merci beaucoup pour ton aide
comment peux ton remplacer le nom des images par les valeurs des cellule
je'ai tester ce code mais ça ne marche pas

Sub renommer()
Dim S As Shape
Dim R As Range
For Each S In ActiveSheet.Shapes
  If S.Type = msoPicture Then
    Set R = S.TopLeftCell
    Set R = R.Offset(0, -1)
    S.Name = R
  End If
Next S
End Sub

 

[anismegrine]

Re : Insertion Plusieurs photos vba

j'ajoute le fichier

 

[job75]

Re : Insertion Plusieurs photos vba

Bonjour anismegrine,

Compte tenu de ceci :

(le nom de l'image doit être le matricule suivi par un p par exemple 952p)

complétez la macro du post #4 :

'-----
  With ActiveSheet.Pictures(CStr(Cells(i, 2)))
    Rows(i).RowHeight = .Height
    .Top = Cells(i, 2).Top
    .Left = Cells(i, 2).Left
    .Name = Cells(i, 1) & "p" 'renomme l'image
  End With

A+

 

[anismegrine]

Re : Insertion Plusieurs photos vba

Merci pour votre coup de main