XL 2013 Boucle en VBA

[PAT83500]

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.
Normalement le fichier était utilisé pour un fichier défini mais comme j'ai de 2 à 700 images j'ai voulu ajouter une boucle et maintenant cela ne fonctionne plus.

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.

 

[danielco]

Bonjour,

Quel classeur contient cette macro ? Dans TraitementPhoto.xlsm, elle est en commentaire.

Daniel

 

[job75]

Bonjour PAT83500, danielco,

Il y a bug dans la macro ChoisirPhoto2 sur If FiChoisi = False Then Exit Sub

Remplacez cette instruction par If Dir(FiChoisi) = "" Then Exit Sub

A+

 

[patricktoulon]

Bonjour
j'ai testé tes images
et la propertie GpsLongitude et GpsLatitude sont vides sur tes photos
par contre les properties GpsLatitureref et GpsLongituderef ont une valeur mais je pense pas que c'est celle que tu souhaite
remarge que dans la properties il n'y a pas d'espaces
prend un classeur vierge
et met lui se code

Sub Bouton1_Cliquer()

'Declare variables
    Dim Image As Object
    Dim RowCounter As Integer

    RowCounter = 1
    dossier = ThisWorkbook.Path & "\PHOTOS"
    fic = Dir(dossier & "\*.*")
    col = 1
    Do While fic <> ""
        Dim tbl(1 To 100, 1 To 2000)
        'Load the image
        Set Image = CreateObject("WIA.ImageFile")
        Image.LoadFile dossier & "\" & fic
        't = t & fic & vbCrLf
        tbl(1, col) = fic
        x = 2
        For Each p In Image.Properties
            On Error Resume Next
            x = x + 1
            tbl(x, col) = p.Name: tbl(x, col + 1) = p.Value
            On Error GoTo 0
        Next

        col = col + 2
        fic = Dir
    Loop
    Feuil1.Cells(1, 1).Resize(UBound(tbl), 2000) = tbl
    Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
End Sub

enregistre le au même endroit ou se trouve le dossier "PHOTOS"(PAS DEDANS HEIN !!!!)
et lance le truc
tu verra pas de coordonnées dispos dans tes photos
pourtant quand je regarde dans les propriétés elles y sont

 

[PAT83500]

Re Bonjour,

Merci pour votre aide.
J'ai changé les photos avec celles originales.
J'ai modifié la ligne : If Dir(FiChoisi) = "" Then Exit Sub

Ca me met bien la première ligne soir le premier fichier 1.jpg et ensuite cela s'arrête, la boucle ne se fait pas.

 

[PAT83500]

Re,
On m'a modifié quelques éléments, et ca fonctionne chez cette personne et pas chez moi je ne comprends pas pourquoi.. ci joint la dernière version.
Chez moi ca bloque sur : .Range(2) = FiRép

 

[job75]

Toujours dans la macro ChoisirPhoto2 :

1) Il ne faut pas utiliser If Dir(FiChoisi) = "" Then Exit Sub mais créer ce bloc :

If Dir(FiChoisi) <> "" Then
'----
End If

2) Dans ce bloc If/End If supprimer ceci qui crée un bug :

Set Img = IP.Apply(Img)

3) Dans ce bloc If/End If supprimer à la fin :

     '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
'Exit For

 

[PAT83500]

Bonjour,

Merci ++++ ca marche enfin..
c'est génial.