Microsoft 365 Ouvrir par VBA, dans un répertoire, le Nième fichier

[FLAXLIB1]

J'ai créé un répertoire de photos sur PC (d:\photos\*.jpeg) que je copie régulièrement sur une clé USB, puis que je laisse défiler à l'écran d'un écran TV. J'ai classé ces photos en leur donnant des noms composés de chiffres et de lettres, choisis pour qu'elles soient toujours lues dans le même ordre par l'écran TV, au fur et à mesure que j'en rajoute.

J'ai aussi créé un fichier Excel qui reprend à chaque ligne le numéro de chaque photo (de 1 à 2000 actuellement), les personnes qui y apparaissent, l'année de prise etc... Je rajoute régulièrement des photos et leur donne un nom qui fait qu'elles s'intègrent là où je le veux, entre d'autres photos existantes .Mais je n'ai pas mis dans ce tableau Excel le nom de fichier de chaque photo, car c'est fastidieux et je risque de faire des erreurs (expl 42A001A .jpeg et 42A001B.jpeg pour la suivante etc).

Je souhaiterais faire une macro VBA où je rentre sur ImputBox un numéro de photo N que je souhaite visualiser (la 735e par exemple), la macro comptant les fichiers sur d:\photos les photos jusqu'à la Nième, et m'ouvrant ensuite cette photo.

C'est le comptage des photos jusqu'à la photo N qui me pose problème. Quelles seraient la/les lignes de commande nécessaire?

 

[patricktoulon]

bonsoir
dans l'ordre de windows tel que tu les a range dans tes options de tri dans la fenêtre explorateur
une simple boucle dir

p=73
folder="D:\mesphotos"
fichiers=dir(folder & "\*jpg")
do while fichiers<>""
x=x+1::if x=p then exit do
fichiers=dir
loop
msgbox  "la " & p  &  " eme photo est le fichier " & fichiers

 

[Bernard_XLD]

Bonjour Flaxlib1, patricktoulon, le forum

Avec Fso, les fichiers sont directement triés par ordre alphabétique.

Bien cordialement, @+
[Code modifié au post suivant]

 

[Bernard_XLD]

re,

le code ci dessous ne liste que les fichiers Jpeg et Jpg
on peut retrouver facilement un fichier par son numéro d'ordre alphabétique
lancer la sub ListerFichiers pour créer la liste
ensuite la sub Trouver_Fichier

Bien cordialement, @+

Public LesFichiers$()

Sub ListerFichiers()
    Dim Fso, Chemin_Dossier$, Liste_Fichiers, Fichier_en_Cours, Compteur&
  
    Chemin_Dossier = "c:\Photos"
  
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Liste_Fichiers = Fso.GetFolder(Chemin_Dossier).Files
    ReDim LesFichiers$(1 To Liste_Fichiers.Count)
    For Each Fichier_en_Cours In Liste_Fichiers
        If Right(Fichier_en_Cours.Name, 5) = ".jpeg" Or Right(Fichier_en_Cours.Name, 4) = ".jpg" Then
            Compteur = Compteur + 1
            LesFichiers(Compteur) = Chemin_Dossier & "\" & Fichier_en_Cours.Name
        End If
    Next
    If Compteur > 0 Then ReDim Preserve LesFichiers$(1 To Compteur)
    MsgBox "Il y a " & Compteur & " fichiers des types Jpeg/Jpg dans le dossier : " & Chemin_Dossier & vbLf & _
        "le premier : " & LesFichiers(1) & vbLf & _
        "le dernier : " & LesFichiers(UBound(LesFichiers)), vbOKOnly + vbInformation
    Set Fso = Nothing
    Set Liste_Fichiers = Nothing
End Sub

Sub Trouver_Fichier()
Dim Compteur&
Compteur = InputBox("entrez un numéro de fichier")
MsgBox "Fichier " & Compteur & " : " & LesFichiers(Compteur), vbOKOnly + vbInformation
End Sub

 

[FLAXLIB1]

bonsoir
dans l'ordre de windows tel que tu les a range dans tes options de tri dans la fenêtre explorateur
une simple boucle dir

p=73
folder="D:\mesphotos"
fichiers=dir(folder & "\*jpg")
do while fichiers<>""
x=x+1::if x=p then exit do
fichiers=dir
loop
msgbox  "la " & p  &  " eme photo est le fichier " & fichiers

Merci pour ta réponse rapide !

Le pb est résolu avec ta boucle de comptage.

 

[patricktoulon]

Bonjour
Attention ne pas jeter au orties ce que @Yeahou t'a donné
d'une part par ce qu'il gère les extension "jpg" et "jpeg"
ensuite l'ordre alphabétique est automatique ça peut apporter un plus dans le sens ou des noms sont assez précis numériquement d’après ton énoncer

pour faire la même chose avec "Dir" il faudrait que je boucle sur un dir vbdirectory

 

[FLAXLIB1]

re,

le code ci dessous ne liste que les fichiers Jpeg et Jpg
on peut retrouver facilement un fichier par son numéro d'ordre alphabétique
lancer la sub ListerFichiers pour créer la liste
ensuite la sub Trouver_Fichier

Bien cordialement, @+

Sub ListerFichiers()
    Dim Fso, Chemin_Dossier$, Liste_Fichiers, Fichier_en_Cours, Compteur&
   
    Chemin_Dossier = "c:\Photos"
   
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Liste_Fichiers = Fso.GetFolder(Chemin_Dossier).Files
    ReDim LesFichiers$(1 To Liste_Fichiers.Count)
    For Each Fichier_en_Cours In Liste_Fichiers
        If Right(Fichier_en_Cours.Name, 5) = ".jpeg" Or Right(Fichier_en_Cours.Name, 4) = ".jpg" Then
            Compteur = Compteur + 1
            LesFichiers(Compteur) = Chemin_Dossier & "\" & Fichier_en_Cours.Name
        End If
    Next
    If Compteur > 0 Then ReDim Preserve LesFichiers$(1 To Compteur)
    MsgBox "Il y a " & Compteur & " fichiers type Jepg/Jpg dans le dossier : " & Chemin_Dossier & vbLf & _
        "le premier : " & LesFichiers(1) & vbLf & _
        "le dernier : " & LesFichiers(UBound(LesFichiers)), vbOKOnly + vbInformation
    Set Fso = Nothing
End Sub

Sub Trouver_Fichier()
Dim Compteur&
Compteur = InputBox("entrez un numéro de fichier")
MsgBox LesFichiers(Compteur)
End Sub

Merci beaucoup pour vos deux réponses qui m'ont permis de résoudre et d'améliorer ma macro !
cordialement,
Flaxlib1

 

[patricktoulon]

ravi pour toi