Mac - Recherche fichiers .xlsm dans dossier et sous-dossiers puis

Le 28/11/2025 à 19:13

Bonsoir le forum,

Je suis sous :

mac os 10.11.6 (El Capitan)

Excel 2011 for Mac

Sujet : Créer une fonction vba qui parcourt un dossier cible avec des sous dossiers ou se trouvent des fichiers (.xlsm).

Une fois les fichiers (.xlsm) trouvés, mettre à jour les liaisons qu’ils contiennent avec le nom du classeur actif.

Nom du classeur actif : « Devis & Facture for Mac (v17.8).xlsm »

Chemin du dossier cible : « SSD macOS El Capitan:Users:MP:Library:Mobile Documents:com~apple~CloudDocs:Devis clients: »

Arborescence du dossier cible :

Devis clients -> clients 1 -> Save for Facture -> xxx.xlsm

-> clients 2 -> Save for Facture -> xxx.xlsm

-> clients 3 -> Save for Facture -> xxx.xlsm

-> etc…

Subtilité : La version du nom du classeur actif (v17.8) est amenée à évoluer (v17.9) -> (v20.0) -> etc… , il faut donc que la fonction prenne en compte cela pour quelle puisse continuer à modifier les liaisons avec la nouvelle version du nom du classeur actif.

——————————————————

Après avoir essayé avec Gemini pendant des heures (des jours même !), je m’aperçois que même les « IA » ont leurs limites…😌

J’ai aussi essayé avec le travail fabuleux de Ron de Bruin, mais je ne suis pas assez compétent pour arriver à combiner tout ça…

MacScript, AppleScript, j’ai essayé un peu tout mais sans résultat.

Je remercie d’avance les personnes qui essaieront de m’aider.

Le 29/11/2025 à 10:27

Bonjour,

Le code ci-dessous permet une recherche récursive sous Windows. Il ne correspond pas tout à fait à votre demande car il recense les fichiers d'un répertoire et ses sous-répertoires et fait les liens hypertextes, alors que dans votre demande, il s'agit d'aller ouvrir un fichier et de reconstituer le lien avec le fichier source.

Nb : Plutôt que de vouloir faire un lien direct avec le fichier source, il serait peut-être intéressant de faire un lien sur une table de correspondance qui permettrait de pointer sur la dernière version du fichier via un lien hypertexte. Cela fait une manip de plus mais le travail de mise à jour serait limité au tableau de correspondance.

En testant dans un premier temps le fonctionnement de ce code, vous pourriez vérifier s'il est totalement incompatible avec MAC pour ensuite compléter le code pour ouvrir le fichier et faire les corrections.

D'après ce que j'ai vu sur la FAQ d'un autre forum par SylkiRoad, il n'y a pas d'incompatibilité dans le code hormis la syntaxe pour désigner un répertoire. Mais peut-être qu'il y aura d'autres problèmes.

Les paramètres de fonctionnement du code sont placés dans un onglet Menu :

capture

Nb : La chaine à rechercher est optionnelle.

Option Explicit

Public IndexListe As Integer, IndexLien As Long
Public Fso As Object
Public Liste_Fichiers  As Variant

Sub ListerLesFichiers(ByVal Repertoire As String, Optional ByVal ChainesARechercher As String)

Dim SupprimerListe As Boolean
Dim I As Long
Dim Debut As String
Dim ShFichiers As Worksheet
Dim TabFichiers As ListObject
Dim LigneFichier As ListRow

    If Repertoire = "" Then
       MsgBox "Saisissez le nom d'un répertoire valide !", vbCritical
       Exit Sub
    End If

    Application.ScreenUpdating = False

    SupprimerListe = False
    If Range("SuppressionListe") = "Oui" Then SupprimerListe = True

    Debut = Repertoire
    Set Fso = CreateObject("Scripting.FileSystemObject")
    IndexListe = 0
    ReDim Liste_Fichiers(3, IndexListe)

    Set ShFichiers = Sheets("Menu")
    With ShFichiers
         Set TabFichiers = .ListObjects("TableDesFichiers")
         If SupprimerListe = True And TabFichiers.ListRows.Count > 1 Then TabFichiers.DataBodyRange.Delete
    End With

    ListeRecursive Fso.GetFolder(Debut), ".xls" ' A adapter

    If IndexListe Then
       For IndexListe = LBound(Liste_Fichiers, 2) To UBound(Liste_Fichiers, 2)
              Set LigneFichier = TabFichiers.ListRows.Add
              With LigneFichier
                   .Range(1, 1) = Liste_Fichiers(0, IndexListe)
                   .Range(1, 2) = Liste_Fichiers(1, IndexListe)
                   .Range(1, 4) = Liste_Fichiers(2, IndexListe)
                   .Range(1, 5) = Liste_Fichiers(3, IndexListe)
              End With
              Set LigneFichier = Nothing
      Next IndexListe
    End If

    For I = TabFichiers.ListRows.Count To 1 Step -1
        With TabFichiers.ListRows(I)
             If .Range(1, 1) = "" Then .Delete
        End With
    Next I

    If TabFichiers.ListRows.Count > 1 Then
       ReconstituerLesLiensHypertextes ShFichiers, TabFichiers.ListColumns(1).DataBodyRange
    End If

    With ShFichiers
        .Activate
        .Columns("A:A").EntireColumn.AutoFit
    End With

    Set Fso = Nothing
    Set ShFichiers = Nothing

    Application.ScreenUpdating = True

    MsgBox "Fin de programme !", vbInformation

End Sub

Sub ListeRecursive(ByVal f As Object, ByVal ChaineATrouver As String)

Dim Sf As Object, Fich As Object, Sf2 As Object

        For Each Fich In Fso.GetFolder(f).Files
            If InStr(1, LCase(Fich.Name), ChaineATrouver, vbTextCompare) > 0 Then
                ReDim Preserve Liste_Fichiers(3, IndexListe)
                Liste_Fichiers(0, IndexListe) = Fich.Name
                Liste_Fichiers(1, IndexListe) = Fich.Path
                Liste_Fichiers(2, IndexListe) = Fich.DateLastModified
                Liste_Fichiers(3, IndexListe) = Fich.DateCreated
                IndexListe = IndexListe + 1
            End If
        Next Fich

    For Each Sf In f.SubFolders
        For Each Fich In Fso.GetFolder(Sf).Files
            If InStr(1, LCase(Fich.Name), ChaineATrouver, vbTextCompare) > 0 Then
                ReDim Preserve Liste_Fichiers(3, IndexListe)
                Liste_Fichiers(0, IndexListe) = Fich.Name
                Liste_Fichiers(1, IndexListe) = Fich.Path
                Liste_Fichiers(2, IndexListe) = Fich.DateLastModified
                Liste_Fichiers(3, IndexListe) = Fich.DateCreated
                IndexListe = IndexListe + 1
            End If
        Next Fich
        ListeRecursive Fso.GetFolder(Sf), ChaineATrouver
    Next Sf

End Sub

Sub ReconstituerLesLiensHypertextes(ByVal ShFichiers2 As Worksheet, ByVal AireFichiers As Range)

Dim I As Long, IndexLien As Long

    IndexLien = 1
    For I = 1 To AireFichiers.Count
        With AireFichiers(I)
             If .Value <> "" Then
                .Hyperlinks.Delete
                ShFichiers2.Hyperlinks.Add Anchor:=AireFichiers(I).Offset(0, 2), Address:=AireFichiers(I).Offset(0, 1), TextToDisplay:=CStr(IndexLien)
                IndexLien = IndexLien + 1
            End If
        End With
     Next I

End Sub

Pour lancer le code :

     ListerLesFichiers Range("Repertoire"), Range("MotsARechercher")

Les références utilisées :

capture1
Le 02/12/2025 à 15:10

Bonjour,

@Eric Kergresse, votre code utilise des activeX et ne fonctionnera pas sous MAC

@iDev4s : vous avez deux outils puissants sous MAC (Spotlight pour la recherche) et surtout Automator (un créateur de tâches) qui pourrait faire ce travail là. Tout cela sans VBA.

Rem :
- Utilisez les points uniquement pour les extensions de fichier (donc pour V17.8 mettez plutôt V17-8)
- Evitez les espaces aussi dans les noms

Maintenant au vu de votre demande, je ne suis pas sûr de bien comprendre lorsque vous parlez de version V17....V18... cela correspon à quoi ?

Rechercher des sujets similaires à "mac recherche fichiers xlsm dossier dossiers puis"