Fichier de suivi

Bonjour à tous,

Je progresse en VBA, grâce à vous, mais toujours trop lentement pour ce que j’ai envie de faire.

Du coup, suite de mes aventures, avec aujourd’hui, un suivi !

J’aimerais que le tableau en Pj se remplisse seul, en allant chercher la présence des fichiers en colonne A dans les dossiers d’une arborescence qu’il m’aurait demandé avec une boîte de dialogue.

Les noms des dossiers sont connus.

La liste des fichiers serait renseignée par moi (il peut y en avoir plus de 2000).

Et du coup, dès qu’un fichier est présent dans un dossier, la case correspondante à la ligne du dossier rougie.

C’est-à-dire que dans le suivi d’un « workflow » à la fin, toutes les cases sont rouges.

Merci, beaucoup à tous ceux qui pourront m’aider.

Seb78

Bonjour Seb78

Pour info, caractère étrange (invisible) dans le nom du dossier parent de l'arborescence du dossier zippé

Sinon voici une possibilité

Sub TestFichierArbo()
  Dim Col As Long, dLig As Long, Lig As Long
  Dim sPathIni As String, Search As String
  ' Demander le choix du dossier parent
  sPathIni = ChoixDossier(ThisWorkbook.Path, "CHOIX du DOSSIER PARENT")
  If sPathIni = "" Then Exit Sub
  ' Sinon on parcours les dossiers indiqués
  With ActiveSheet
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Parcourir chaque colonne
    For Col = 2 To .Range("G1").Column
      ' Parcourir chaque ligne
      For Lig = 3 To dLig
        Search = sPathIni & "\" & .Cells(2, Col) & "\" & .Range("A" & Lig) & ".txt"
        .Cells(Lig, Col).Value = Dir(Search) <> ""
      Next Lig
    Next Col
  End With
End Sub

Function ChoixDossier(DefautPath As String, sTitre As String)
  Dim fd As FileDialog
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  With fd
    .Title = sTitre
    .InitialFileName = DefautPath
    If .Show = -1 Then
      ChoixDossier = fd.SelectedItems(1)
    End If
  End With
  Set fd = Nothing
End Function

Et le fichier avec le code

A+

Bonjour BrunoM45,

Pour l'histoire du caractère spécial… Je ne sais absolument pas du tout d'où ça vient… C'est corrigé, merci !

Concernant le code, c'est "quasi-parfait"... J'aurais juste deux questions :

1/ est-ce possible que la case passe en rouge (au lieu du vrai) et que rien ne s'affiche quand au lieu de faux,

2/ Est-ce possible que dans la case, on indique la date de dernier enregistrement du fichier pour chaque occurrence afin d'automatiser un suivi sur les délais de passage d'un état au suivant ?

Si cela demande trop de travail, laisse tomber, c'est déjà énorme ton truc !

Merci encore,

Seb78

Salut Seb78

1/ est-ce possible que la case passe en rouge (au lieu du vrai) et que rien ne s'affiche quand au lieu de faux,

Pour ça, tu peux faire une simple MFC : si VRAI alors fond rouge, écriture rouge; si FAUX alors écriture blanche

Sinon au lieu d'écrire directement le résultat, il faut faire un test

' .Cells(Lig, Col).Value = Dir(Search) <> ""
If Dir(Search) <> "" Then
 .Cells(Lig, Col).Interior.Color = 255
Endif

Pour ce qui concerne

2/ Est-ce possible que dans la case, on indique la date de dernier enregistrement du fichier pour chaque occurrence afin d'automatiser un suivi sur les délais de passage d'un état au suivant ?

Oui, c'est tout à fait possible, voici

Option Explicit

Sub TestFichierArbo()
  Dim Col As Long, dLig As Long, Lig As Long
  Dim sPathIni As String, Search As String
  ' Demander le choix du dossier parent
  sPathIni = ChoixDossier(ThisWorkbook.Path, "CHOIX du DOSSIER PARENT")
  If sPathIni = "" Then Exit Sub
  ' Sinon on parcours les dossiers indiqués
  With ActiveSheet
    dLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Parcourir chaque colonne
    For Col = 2 To .Range("G1").Column
      ' Parcourir chaque ligne
      For Lig = 3 To dLig
        Search = sPathIni & "\" & .Cells(2, Col) & "\" & .Range("A" & Lig) & ".txt"
        ' # Modif du 13/12
        If Dir(Search) <> "" Then
          .Cells(Lig, Col).Value = Format(FileDateTime(Search), "dd/mm/yyyy")
          .Cells(Lig, Col).Interior.Color = 255
        End If
      Next Lig
    Next Col
  End With
End Sub

Function ChoixDossier(DefautPath As String, sTitre As String)
  Dim fd As FileDialog
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  With fd
    .Title = sTitre
    .InitialFileName = DefautPath
    If .Show = -1 Then
      ChoixDossier = fd.SelectedItems(1)
    End If
  End With
  Set fd = Nothing
End Function

A+

T'as jamais fais fondre un clavier à taper si vite ?

Re,

si si

Merci BEAUCOUP !

C'est parfait !