Boucle For Next macro excel qui bloque

Bonjour,

J'ai une macro qui doit se répéter sur tous les fichiers du répertoire identifié, j'ai essayé plusieurs possibilités, sans succès.

Le premier fichier se passe bien, et ensuite sur la boucle ca s'arrête en débogage sur      FiChoisi.Close False

Merci d'avance sur votre aide.

Sub ChoisirPhoto2()
'Désigner une photo, importer des propriétés EXIF, créer une miniature
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
     Dim WSh As Worksheet, LO As ListObject, Lgn As Range
     Set WSh = Sh_Liste
     Set LO = WSh.ListObjects("tb_Photos")
     
     Dim FSO As New FileSystemObject
     Dim FiChoisi As Variant, FiNom$, FiRép$, RéfAltitude$, CheminTmp$
     
     Dim Image As Shape, Img As New WIA.ImageFile, IP As New WIA.ImageProcess
     Dim Ps As WIA.Properties, P As WIA.Property
  Dim FileName As String
  Dim i As Integer
i = 1
For i = i To 700
    
     FiChoisi = ThisWorkbook.Path & "\PHOTOS\" & i & ".jpg"
     'InitialFileName = (ThisWorkbook.Path & "\PHOTOS\1.jpg")
     If FiChoisi = False Then Exit Sub
     
     FiNom = FSO.GetFileName(FiChoisi)
     FiRép = Replace(FiChoisi, FiNom, "")
    
 
'Ligne sur laquelle enregistrer les données
     With WSh.Evaluate(LO.Name)
          Set Lgn = .Rows(.Rows.Count)
          'Vérifier que la ligne ne contient que la formule sinon se décaler vers le bas
          If WorksheetFunction.CountA(Lgn) > 1 Then Set Lgn = Lgn.Offset(1)
     End With
    
'Charger la photo, récupérer ses propriétés
     Img.LoadFile FiChoisi
     Set Ps = Img.Properties

'Récupération des données EXIF
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Altitude
     Niveau = ""
     Altitude = ""
     If Ps.Exists("GpsAltitudeRef") Then
          Set P = Ps("GpsAltitudeRef")
          Niveau = P.Value
          Select Case Niveau
          Case 0
               signe = 1
          Case 1
               signe = -1
          End Select
          If Ps.Exists("GpsAltitude") Then Altitude = signe * LireAltLatLong(Ps("GpsAltitude"))
     End If
'Latitude
     LatitudeRéf = ""
     Latitude = ""
     If Ps.Exists("GpsLatitudeRef") Then
          Set P = Ps("GpsLatitudeRef")
          LatitudeRéf = P.Value
          Select Case LatitudeRéf
          Case "N"
               signe = 1
          Case "S"
               signe = -1
          End Select
          If Ps.Exists("GpsLatitude") Then Latitude = signe * LireAltLatLong(Ps("GpsLatitude"))
     End If
'Longitude
     LongitudeRéf = ""
     Longtitude = ""
     If Ps.Exists("GpsLongitudeRef") Then
          Set P = Ps("GpsLongitudeRef")
          LongitudeRéf = P.Value
          Select Case LongitudeRéf
          Case "E"
               signe = 1
          Case "O", "W"
               signe = -1
          End Select
          If Ps.Exists("GpsLongitude") Then Longitude = signe * LireAltLatLong(Ps("GpsLongitude"))
     End If
'Auteur
     Auteur = ""
     If Ps.Exists("Artist") Then Auteur = Ps("Artist").Value
'Date du cliché
     DateCliché = ""
     If Ps.Exists("DateTime") Then DateCliché = Replace(Ps("DateTime"), ":", "/", 1, 2)

'Orientation de la photo (pour obtenir une orientation correcte de la miniature)
     If Ps.Exists("Orientation") Then
          Select Case Ps("Orientation").Value
               Case 1
                    RotationAngle = 0
                    FlipHorizontal = False
               Case 2
                    RotationAngle = 0
                    FlipHorizontal = True
               Case 3
                    RotationAngle = 180
                    FlipHorizontal = False
               Case 4
                    RotationAngle = 180
                    FlipHorizontal = True
               Case 5
                    RotationAngle = 90
                    FlipHorizontal = False
               Case 6
                    RotationAngle = 90
                    FlipHorizontal = False
               Case 7
                    RotationAngle = 270
                    FlipHorizontal = True
               Case 8
                    RotationAngle = 270
                    FlipHorizontal = False
          End Select
     End If

'Créer une vignette (100 x 100 maxi)
'Orientation
     IP.Filters.Add IP.FilterInfos("RotateFlip").FilterID
     IP.Filters(1).Properties("RotationAngle") = RotationAngle
     IP.Filters(1).Properties("FlipHorizontal") = FlipHorizontal
'Réduction à 100 pixels max (largeur ou hauteur) en gardant les proportions
    IP.Filters.Add IP.FilterInfos("Scale").FilterID
     IP.Filters(2).Properties("MaximumHeight") = 100
     IP.Filters(2).Properties("MaximumWidth") = 100
'Application des transformations via les filtres
     Set Img = IP.Apply(Img)
     
 'Enregistrement temporaire du fichier miniature (le temps d'importer la miniature)
     CheminTmp = "C:\tmp_img\"
     On Error Resume Next
     MkDir CheminTmp
     Kill CheminTmp & "Thumb" & FiNom
     On Error GoTo 0
     Img.SaveFile CheminTmp & "Thumb" & FiNom
     
 'Enregistrement des propriétes EXIF à la fin du tableau
     With Lgn
          .Cells(2) = FiRép
          .Cells(3) = FiNom
          .Cells(4) = Auteur
          .Cells(5) = DateCliché
          .Cells(6) = Niveau
          .Cells(7) = Altitude
          .Cells(8) = LatitudeRéf
          .Cells(9) = Latitude
          .Cells(10) = LongitudeRéf
          .Cells(11) = Longitude
    End With
    
     Set Image = WSh.Shapes.AddPicture(FileName:=CheminTmp & "Thumb" & FiNom, _
                                       linktofile:=msoFalse, SaveWithdocument:=msoCTrue, _
                                       Top:=Lgn.Cells(1, 1).Left, Left:=Lgn.Cells(1, 1).Top, Width:=-1, Height:=-1)
     
     With Image
'Renommer l'image importée
          .Name = Format(Now, "yyyy:mm:dd_hh:mm:ss")
          Lgn.Cells(1) = .Name
          .Rotation = 0
     'Position (bis) sur le coin sup gauche de la 1ère cellule de la ligne (+1 pour être dans la cellule)
          .Left = Lgn.Cells(1, 1).Left + 1
          .Top = Lgn.Cells(1, 1).Top + 1
     'Conserver le ratio H/L avant le redimensionnement
          .LockAspectRatio = msoTrue
     'Réglage de la hauteur (= hauteur de la ligne -2)
          .Height = Lgn.Cells(1, 1).Height - 2
     'Texte de remplacement
          .AlternativeText = ""
     'Associer à la macro "MontrerPhoto" (via clic)
          .OnAction = "MontrerPhoto"
     End With

'Supprimer le fichier miniature temporaire
     Kill CheminTmp & "Thumb" & FiNom
     
     Set P = Nothing:     Set Ps = Nothing:     Set IP = Nothing:     Set Img = Nothing:     Set Image = Nothing
     Set Lgn = Nothing:     Set LO = Nothing:     Set WSh = Nothing
     Set FSO = Nothing
     FiChoisi.Close False

     Next i
End Sub

Function LireAltLatLong(P As Property) As Variant
'Interpréte la propriété (Valable pour altitude, latitude, et longitude)
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
     LireAltLatLong = ""
     If P.IsVector Then
          If TypeOf P.Value Is Vector Then
               If TypeOf P.Value(1) Is Rational And TypeOf P.Value(2) Is Rational And TypeOf P.Value(2) Is Rational Then
                    LireAltLatLong = P.Value(1).Numerator / P.Value(1).Denominator + _
                                  (P.Value(2).Numerator / P.Value(2).Denominator) / 60 + _
                                  (P.Value(3).Numerator / P.Value(3).Denominator) / 3600
               End If
          End If
     ElseIf TypeOf P.Value Is Rational Then
               LireAltLatLong = P.Value.Numerator / P.Value.Denominator
     End If
     Set P = Nothing
End Function

Sub MontrerPhoto()

End Sub
'Charge la photo appelante et la ré-oriente correctement
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
     Dim repère$, ShpImage As Shape, C As Range, NomFichier$, NomCompletFichier$
     Dim Image As Picture, Img As New WIA.ImageFile, IP As New WIA.ImageProcess
     Dim Ps As WIA.Properties, P As WIA.Property
     Dim TempAffichage%
     
     On Error Resume Next
     repère = Application.Caller
     If repère = "" Then Exit Sub

'Shape Appelante
     Set ShpImage = ActiveSheet.Shapes(repère)
     On Error GoTo 0
     If ShpImage Is Nothing Then Exit Sub

'Récupérer le nom du fichier via la cellule contenant la miniature
     Set C = ShpImage.TopLeftCell
     NomFichier = C.Offset(0, 2)
     NomCompletFichier = C.Offset(0, 1) & NomFichier

'Vérifier l'existence du fichier
     If Dir(NomCompletFichier) = "" Then
          Msg = "Le fichier : " & NomCompletFichier & Chr(10) & "n'existe plus"
          Style = vbOKOnly + vbExclamation
          Title = "Affichage photo "
          Resp = MsgBox(Msg, Style, Title)
          Exit Sub
     End If

'Charger l'image
     Img.LoadFile NomCompletFichier
'Récupérer ses propriétés
    Set Ps = Img.Properties

'Orientation de la photo (pour obtenir une orientation correcte dans le UserForm)
    If Ps.Exists("Orientation") Then
          Select Case Ps("Orientation").Value
               Case 1
                    RotationAngle = 0
                    FlipHorizontal = False
               Case 2
                    RotationAngle = 0
                    FlipHorizontal = True
              Case 3
                    RotationAngle = 180
                    FlipHorizontal = False
               Case 4
                    RotationAngle = 180
                    FlipHorizontal = True
               Case 5
                    RotationAngle = 90
                    FlipHorizontal = False
               Case 6
                    RotationAngle = 90
                    FlipHorizontal = False
               Case 7
                    RotationAngle = 270
                    FlipHorizontal = True
               Case 8
                    RotationAngle = 270
                    FlipHorizontal = False
          End Select
     End If
'Orientation
     IP.Filters.Add IP.FilterInfos("RotateFlip").FilterID
     IP.Filters(1).Properties("RotationAngle") = RotationAngle
    IP.Filters(1).Properties("FlipHorizontal") = FlipHorizontal
''Application des transformations via les filtres
     Set Img = IP.Apply(Img)
'Enregistrement temporaire du fichier miniature (le temps d'importer la miniature)
     CheminTmp = "C:\tmp_img\"
     On Error Resume Next
     MkDir CheminTmp
     Kill CheminTmp & NomFichier
     On Error GoTo 0
     Img.SaveFile CheminTmp & NomFichier
          
'Affichage dans le UserForm pendant 3 s
     TempAffichage = 3
     With UsF_Photo
          .Caption = NomCompletFichier
          .Picture = LoadPicture(CheminTmp & NomFichier)
          Kill CheminTmp & NomFichier
          .Show
          DoEvents
          waitTime = TimeSerial(newHour, newMinute, newSecond)
          Application.Wait Now + TimeSerial(0, 0, TempAffichage)
     End With
     Unload UsF_Photo
     
End Sub