XL 2019 Excel VBA - Condition selon le nom du fichier

OuiOuiNonNon

XLDnaute Nouveau
Bonjour à tous,
Merci d'avance à toute les personnes qui pourront m'aider en cette toute fin d'année (ou début 2021 si des réponses arrivent demain :) )

Je met ci-joints 4 fichiers.

Tout d'abord, le nom d'un fichier se décompose comme cela : "Nom_Prénom_Année_Mois_Jour_Heure_Minute_Seconde_Code"

Dans le fichier "COLLARD_GILBERT_2020_12_28_18_08_32_XHAG", il y a un Private Sub :

VB:
Private Sub Workbook_Open()

Dim Fichier As String 'Fichier
Dim Chemin As String 'Chemin
Dim CS As Workbook 'Classeur Source
Dim CD As Workbook 'Classeur Destination
Dim NF As String 'Nom Fichier
Dim Classeur As String 'Classeur
Dim DL As Long 'Dernière Ligne
Dim DC As Integer 'Dernière Colonne
Dim L As Integer 'Ligne
Dim C As Integer 'Colonne
Dim DLX As Integer 'Dernière Ligne X

Set CD = ThisWorkbook 'Définit le Classeur Destination
Classeur = CD.Name 'Définit le Classeur
Chemin = CD.Path 'Définit le Chemin
Application.ScreenUpdating = False 'Masque les rafraîchissements d'écran
   With CD 'Avec le Classeur Destination
      DL = Feuil1.Cells(Rows.Count, 4).End(xlUp).Row 'Trouve la dernière ligne
      DC = Feuil1.Cells(2, Cells.Columns.Count).End(xlToLeft).Column 'Trouve la dernière colonne
   End With 'Fin DL et DC Classeur Destination
   NF = Left(Split(ThisWorkbook.Name, ".")(0), 10) 'Récupère les 10 premiers caractères du nom du fichier
   Fichier = Dir(Chemin & "\*.xls*") 'Ouvre les fichiers excel se trouvant sur le même dossier
   Do 'Faire
      If Fichier = "" Then Exit Do 'Si il n'y a plus de fichiers
      If Fichier <> ThisWorkbook.Name Then 'Si le nom de fichier ne correspond pas
         If Fichier Like NF & "*.xlsm" Then 'Si le nom de fichier correspond
            Set CS = Workbooks.Open(Chemin & "\" & Fichier) 'Définit le Classeur Source
            For C = 5 To DC 'Boucle sur les colonnes
               DLX = Workbooks(Fichier).Sheets(1).Cells(Rows.Count, C).End(xlUp).Row 'Dernière Ligne de chaque colonne
               If DLX > 2 Then ' Si > 2 donc contient des données
                  With Workbooks(Classeur).Sheets(1) 'Avec le Classeur Destination
                     .Range(.Cells(3, C), .Cells(DL, C)) = "" 'Efface la colonne
                  End With 'Fin effacement colonne Classeur Destination
               End If 'Fin si DLX > 2
            Next C 'Prochaine colonne
            Application.DisplayAlerts = False 'Bloque le message d'alerte
            CS.Close True 'Ferme le Classeur Source
            Application.DisplayAlerts = True 'Autorise le message d'alerte
         End If 'Fin de la condition si le nom de fichier correspond
      End If 'fin de la condition si il n'y a plus de fichiers ou le nom de fichier ne correspond pas
      Fichier = Dir() 'Passe au fichier suivant
   Loop 'Boucle
   CD.Save 'Sauvegarde le Classeur Destination
Application.ScreenUpdating = True 'Affiche les rafraîchissements d'écran
End Sub

Lors de l'ouverture du fichier, la macro va regarder tout les fichiers qui commence par "COLLARD_GILBERT" puis gérer les doublons.

Ce que j'aimerais faire, c'est mettre cette macro dans chacun des fichiers, sauf que si j'active cette macro depuis le fichier "COLLARD_GILBERT_2020_12_26_12_24_44_ABFE", qui date donc du 26 décembre 2020, elle va regarder le fichier Collard Gilbert qui date du 28 décembre et regarder le fichier Collard qui date du 24 décembre.
J'aimerais mettre alors une condition, pour que quand une macro s'active, elle ne regarde que les fichiers plus anciens.

C'est à dire, pour le fichier Collard Gilbert qui date du 26 décembre 2020, qu'elle ne regarde que les fichiers Collard Gilbert d'avant le 26 décembre 2020.

De plus, dans le cas présent il n'y a pas beaucoup de fichier, mais a terme, il y en aura +, avec des fichiers datant du même jour, et même de la même heure, ce qui rend la condition plus précise (donc condition sur l'année, le mois, le jour, l'heure, la minute, et pourquoi pas de la seconde).

PS : On ne peut pas se servir du code dans la macro
 

Pièces jointes

  • COLLARD_GILBERT_2020_12_28_18_08_32_XHAG.xlsm
    22.2 KB · Affichages: 18
  • COLLARD_GILBERT_2020_12_24_10_45_02_AZDOPAFA.xlsm
    11.2 KB · Affichages: 2
  • COLLARD_GILBERT_2020_12_26_12_24_44_ABFE.xlsm
    15.4 KB · Affichages: 2
  • THIERRY_MARX_2020_12_25_12_24_52_ABFE.xlsx
    10.8 KB · Affichages: 1

OuiOuiNonNon

XLDnaute Nouveau
Bonsoir BrunoM45,
Cette macro et ces fichiers sont une petite partie d'un projet avec des contraintes auquel je suis soumis, ces contraintes sont assez fortes, mais elles sont privées donc je n'en parlerais pas ici mais de ce fait, et malheureusement, il n'est pas possible pour moi de procéder de cette façon. :)
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

=>OuiOuiNonNon
[questionnement un soir de 31/12 - bientôt l'apéro]
A partir du moment ou tu as accès aux fichiers
(qui sont donc stockés sur ton disque dur)
Plus aucune contrainte n'existe non?
Tu peux faire subir ce que tu veux à ces fichiers.
Notamment suivre la piste évoquée par BrunoM45.
[/questionnement un soir de 31/12 - bientôt l'apéro]
 

OuiOuiNonNon

XLDnaute Nouveau
Je comprend ce que tu veux dire.
Après, je ne vois pas aujourd'hui comment il est possible de faire ce que je souhaite à partir d'un fichier "maitre", c'est surement possible, mais avec mon niveau en VBA, je ne vois pas comment y arriver.
Il faudrait réussir, à partir d'un fichier "maitre", à ouvrir chaque fichier du dossier, pour chaque nom, du plus ancien au plus récent, pour leur faire appliquer la suppression des doublons selon les conditions que j'ai cité plus haut. A voir mais cette histoire me parait complexe 😬
 

Staple1600

XLDnaute Barbatruc
Re

C'est là que les petits gars et les "petites filles"
Non, disons plutôt, la grande famille des répondeurs XLDiens intervient pour aider le jeune (ou vieux) padawan en détresse au bord de l'autoroute VBA-XLS ;)

Mais comme déjà suggéré dans ton autre fil par un XLDien, plus le "cahier des charges" sera détaillé et précis (on n'est pas dans ta tête) plus on pourra t'aider efficacement ;)
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 904
Membres
101 834
dernier inscrit
Jeremy06510