XL 2019 Création d'une macro permettent d'ouvrir le fichier le plus recent d'un dossier

Cesar1275

XLDnaute Nouveau
Bonjour à tous

J'ai un blocage sur la création d'une macro dans un tableau excel sur lequel je suis en train de travailler.

En effet, je cherche une fonction me permettant d'ouvrir le fichier le plus recent d'un dossier.

Voici comment sont nommés les fichiers en question :
1604323866827.png

En l'occurence, j'aurais besoin que la macro ouvre le fichier 201029.

Est ce que quelqu'un pourrais m'aider svp ?

Merci d'avance !
 
Solution
Bonjour,
La feuille Moy jour existe bien
Faux. Votre fichier Classeur1.xlsm ne possède pas de feuille nommée Moy Jour, c'est le fichier Suivi Qualité qui a cette feuille.
Donc évidemment les lignes comportant ça :
VB:
Workbooks("Classeur1.xlsm").Sheets("Moy Jour").Range(....
ne peuvent qu'être qu'en erreur.
J'ai rectifié ces 4 lignes :
Code:
    Workbooks("Classeur1.xlsm").Activate
    AncienneQuantité = Sheets("Feuil1").Range("E" & L)
    ' Recalcul l'ancienne somme avec les anciennes moyennes et quantité
    AncienneSomme = Sheets("Feuil1").Range("D" & L) * AncienneQuantité
    ' Stocke la nouvelle moyenne
    Sheets("Feuil1").Range("D" & L) =...

Lolote83

XLDnaute Accro
Bonjour CESAR1275,
Voici un petit fichier qui permet de lister l'ensemble des fichiers contenus dans un répertoire défini en cellule C1.
La macro liste les fichiers et récupère le plus récent qu'elle ouvre (fichier excel).
Attention, pour que cela fonctionne, il faudra activer la référence VBA "Microsof Scripting Runtime"
Tout est dans le fichier joint
@+ Lolote83
 

Pièces jointes

  • Copie de CESAR1275 - Ouvre fichier le plus recent.xlsm
    49 KB · Affichages: 4

sylvanu

XLDnaute Barbatruc
Supporter XLD
Ave Cesar, Lolotte,
En PJ un essai test avec :
VB:
Sub FichierLePlusRecent()
Dim Rep As String, Fichier As String, i As Integer, Liste(1000), DateFile(1000), DateFichier, Indice As Integer
[D6] = ""
[D7] = ""
On Error GoTo Fin
i = 0
Rep = [Directory]
If Right(Rep, 1) <> "\" Then Rep = Rep & "\"    ' Le nom doit se terminer par \
Fichier = Dir(Rep)
Do While Fichier <> ""
    i = i + 1
    Liste(i) = Fichier
    DateFile(i) = FileDateTime(Rep & Fichier) ' Enregistre la date de création du fichier ( en type date )
    Fichier = Dir
Loop
DateFichier = 0
For i = 1 To UBound(DateFile)
    If DateFile(i) > DateFichier Then
        DateFichier = DateFile(i)
        Indice = i
    End If
Next i
[D6] = Liste(Indice)
[D7] = DateFile(Indice)
Fin:
End Sub
 

Pièces jointes

  • FichierRecent.xlsm
    15.8 KB · Affichages: 5

Cesar1275

XLDnaute Nouveau
Merci Beaucoup pour vos réponses super rapides !

Lolote83:

J'ai ouvert le fichier que tu m'a envoyé mais cette macro permet uniquement de lister des fichiers présents dans un dossier. Or j'ai besoin une macro me permettant d'ouvrir simplement le fichier le plus récent d'un dossier ;)

Sylvanu:

J'ai essayé ta macro mais il ne se passe rien lorsque je l'execute ...

Merci encore pour votre aide et désolé si ma réponse peut paraitre bête mais je suis vraiment débutant dans VBA !
 

Cesar1275

XLDnaute Nouveau
En réalité j'aurais besoin d'intégrer cette macro au sein d'une autre que j'ai déja commencé à coder.
Celle ci permet d'aller ouvrir un fichier et de copier coller des données dans un autre tableau.

Le problème est que j'ai besoin d'ouvrir uniquement le dernier fichier présent dans le répertoir.

Sub Transfert_de_données()
Workbooks.Open "C:\Users\victo\Documents\SNCF\Tableaux ICV\Tableaux brutes\Suivi_Qualité_ICV_201029.xlsx"
Workbooks("Suivi_Qualité_ICV_201029.xlsx").Sheets("Moy Jour").Range("D3:D12").Copy
Workbooks("Classeur1.xlsm").Activate
Workbooks("Classeur1.xlsm").Sheets("Feuil1").Range("D3:D12").Select
Workbooks("Classeur1.xlsm").Sheets("Feuil1").Paste
Workbooks("Suivi_Qualité_ICV_201029.xlsx").Close

MsgBox "Les données ont été actualisées avec succès"
End Sub

Voici le code la la macro en question.
J'ai mis en rouge l'adresse du fichier le plus rescent du dossier mais il y en a un nouveau chaque jour.
J'aimerais que tu puisse intégrer ta macro à ce code ce qui permetrait à ma macro d'ouvrir le dernier fichier de ce dossier ;)

Merci d'avance pour votre réponse !
 

Lolote83

XLDnaute Accro
Re bonjour CESAR1275,
Ton bout de code intégré dans mon fichier
Attention, les cellules en J1 et J2 sont utiles pour l'ouverture du fichier (A ne pas supprimer)
Sinon, adapte tout ceci sur le code de Sylvanu.
J'ai mis en dur ton chemin sur la cellule C1.
@+ Lolote83
 

Pièces jointes

  • Copie de CESAR1275 - Ouvre fichier le plus recent - V2.xlsm
    48.9 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re tout le monde,
A tester. J'ai mixé les deux macros.
VB:
Public Rep As String, FichierRecent As String
Sub Transfert_de_données()
' Fixe le répertoire à analyser
Rep = "C:\Users\victo\Documents\SNCF\Tableaux ICV\Tableaux brutes\"
' Recherche le fichier le plus récent
FichierLePlusRecent
' Et l'ouvre.
Workbooks.Open Rep & FichierRecent
' Le reste est identique
Workbooks(FichierRecent).Sheets("Moy Jour").Range("D3:D12").Copy
Workbooks("Classeur1.xlsm").Activate
Workbooks("Classeur1.xlsm").Sheets("Feuil1").Range("D3:D12").Select
Workbooks("Classeur1.xlsm").Sheets("Feuil1").Paste
Workbooks(FichierRecent).Close
MsgBox "Les données ont été actualisées avec succès"
End Sub
Sub FichierLePlusRecent()
Dim Fichier As String, i As Integer, Liste(1000), DateFile(1000), DateFichier, Indice As Integer
On Error GoTo Fin
i = 0
If Right(Rep, 1) <> "\" Then Rep = Rep & "\"    ' Le nom doit se terminer par \
Fichier = Dir(Rep)
Do While Fichier <> ""
    i = i + 1
    Liste(i) = Fichier
    DateFile(i) = FileDateTime(Rep & Fichier) ' Enregistre la date de création du fichier ( en type date )
    Fichier = Dir
Loop
DateFichier = 0
For i = 1 To UBound(DateFile)
    If DateFile(i) > DateFichier Then
        DateFichier = DateFile(i)
        Indice = i
    End If
Next i
FichierRecent = Liste(Indice)
Fin:
End Sub
 

Cesar1275

XLDnaute Nouveau
Merci Sylvanu !

J'ai testé ta macro mais elle ouvre le fichier "Suivi_Qualité_ICV_201023" or ce fichier est le premier et non pas le dernier du dossier ...
dans mon exemple il faudrait que la macro ouvre le fichier "Suivi_Qualité_ICV_201029"

Merci d'avance ! ;)
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
J'ai un ti bug si le fichier n'est pas dans le dossier courant.
Par contre il ouvre bien le plus récent.
VB:
Public Rep As String, FichierRecent As String
Sub Transfert_de_données()
' Fixe le répertoire à analyser
Rep = "C:\Users\victo\Documents\SNCF\Tableaux ICV\Tableaux brutes\"
' Recherche le fichier le plus récent
FichierLePlusRecent
' Et l'ouvre.
Workbooks.Open Rep & FichierRecent
' Le reste est identique
Workbooks(Rep & FichierRecent).Sheets("Moy Jour").Range("D3:D12").Copy
Workbooks("Classeur1.xlsm").Activate
Workbooks("Classeur1.xlsm").Sheets("Feuil1").Range("D3:D12").Select
Workbooks("Classeur1.xlsm").Sheets("Feuil1").Paste
Workbooks(Rep & FichierRecent).Close
MsgBox "Les données ont été actualisées avec succès"
End Sub
Sub FichierLePlusRecent()
Dim Fichier As String, i As Integer, Liste(1000), DateFile(1000), DateFichier, Indice As Integer
On Error GoTo Fin
i = 0
If Right(Rep, 1) <> "\" Then Rep = Rep & "\"    ' Le nom doit se terminer par \
Fichier = Dir(Rep)
Do While Fichier <> ""
    i = i + 1
    Liste(i) = Fichier
    DateFile(i) = FileDateTime(Rep & Fichier) ' Enregistre la date de création du fichier ( en type date )
    Fichier = Dir
Loop
DateFichier = 0
For i = 1 To UBound(DateFile)
    If DateFile(i) > DateFichier Then
        DateFichier = DateFile(i)
        Indice = i
    End If
Next i
FichierRecent = Liste(Indice)
Fin:
End Sub
 

Lolote83

XLDnaute Accro
Re bonjour,
Je poste quand même la version V3 qui corrige un bug de la V2.
J'ai juste rajouté l'option des fichiers XL seulement (et pas les pdf, word, jpg etc etc etc)
Mais Sylvanu a encore frappé !!!!
@+ Lolote83
 

Pièces jointes

  • Copie de CESAR1275 - Ouvre fichier le plus recent - V3.xlsm
    53 KB · Affichages: 2

Cesar1275

XLDnaute Nouveau
Merci à vous 2 pour vos réponses !

Sylvanu j'ai de nouveau testé ta macro. En effet elle ouvre bien le fichier le plus recent mais elle n'arrive pas à copier coller les données.

1604331207845.png


Voici la capture d'écran
En fluo la ligne indiquée comme ayant un problème

Merci d'avance
 

Lolote83

XLDnaute Accro
Re bonjour,
Peut être faut-il supprimer Rep dans la ligne en question

Workbooks(Rep & FichierRecent).Sheets("Moy Jour").Range("D3:D12").Copy deviendrait
Workbooks(FichierRecent).Sheets("Moy Jour").Range("D3:D12").Copy

de même plus bas
Workbooks(Rep & FichierRecent).Close deviendrait
Workbooks(FichierRecent).Close

As tu testé ma version3 ?
@+ Lolote83
 

Discussions similaires

Haut Bas