Bonsoir Le Forum,
Voici une série de lignes de VBA dans un fichier trop lourd pour vous le transmettre ici.
La ligne "PlaceThePictureInCenterRange Cells", au milieu de ce qui suit, est bloquant et je n'arrive pas à trouver la solution pour que les photos soient rapatriées de mon dossier TROMBINOSCOPE avec un chemin correct placé en cellule [AM1].
Pouvez-vous me trouver l'erreur, ou l'oubli dans la saisie ?
Merci
Webperegrino
Voici une série de lignes de VBA dans un fichier trop lourd pour vous le transmettre ici.
La ligne "PlaceThePictureInCenterRange Cells", au milieu de ce qui suit, est bloquant et je n'arrive pas à trouver la solution pour que les photos soient rapatriées de mon dossier TROMBINOSCOPE avec un chemin correct placé en cellule [AM1].
Pouvez-vous me trouver l'erreur, ou l'oubli dans la saisie ?
Merci
Webperegrino
VB:
Sub CommandButton5_Cliquer()
'place les photos dans la colonne A (le prénom est en colonne B et le nom en colonne C
‘les photos dans TROMBINOSCOPE sont nommées Prénom + espace + Nom.JPG
[A3:A161].ClearContents: [A2] = 0
'placement des formules
Application.ScreenUpdating = True
[A3].FormulaLocal = "=NBVAL(B3)+A2*NBVAL(B3)"
'en ce qui concerne mon fichier actuel :
'en [A3] prend la valeur 1,
'en [A4] prend la valeur 2, etc ...
'jusqu'à la ligne 99 où [A99] prend la valeur 99
Range("A3").Copy Range("A4:A161")
'efface les photos éventuellement en place
Dim s As Shape
'Application.ScreenUpdating = False
For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, [A3:A161]) Is Nothing Then
s.Delete
End If
Next
'place les photos du TROMBINOSCOPE
Dim Row As Integer, col As Integer
Dim File As Variant, Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
[A1] = 0
Row = 3
col = Columns("A").Column
[A3].FormulaLocal = "=NBVAL(B3)+A2*NBVAL(B3)"
PhotoDir = [AM1] & "TROMBINOSCOPE\"
For Row = 3 To 161
For Each File In Fso.GetFolder([PhotoDir]).Files
If File.Name Like "*.jpg" Then
[A1] = [A1] + 1
If Cells(Row, col + 1) & " " & Cells(Row, col + 2) = Fso.getBasename(File) Then
'la ligne suivante bloque la macro :
PlaceThePictureInCenterRange Cells(Row, col), Shapes.AddPicture(File, False, True, 20, 20, -1, -1), 90
' la photo .JPG n'apparaît pas dns la cellule...
'Je ne trouve pas l'erreur.
End If
End If
Next
Next
Set Fso = Nothing ' Libération mémoire
Application.ScreenUpdating = True
End Sub