IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

VBA : Code pour supprimer automatiquement les liaisons des feuilles de plusieurs classeurs [XL-365]


Sujet :

Macros et VBA Excel

  1. #1
    Membre du Club
    Homme Profil pro
    Suivi Evaluation
    Inscrit en
    Novembre 2010
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vaucluse (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Suivi Evaluation
    Secteur : Conseil

    Informations forums :
    Inscription : Novembre 2010
    Messages : 54
    Points : 51
    Points
    51
    Par défaut VBA : Code pour supprimer automatiquement les liaisons des feuilles de plusieurs classeurs
    Bonjour,
    J'ai des classeurs Modéle par projet (40 projets => 40 classeurs). Chaque classeur Modèle contient 2 feuilles : i) une feuille Menu (pour gérer la date et le statut) et ii) une feuille de collecte (qui contient des formules faisant référence à la feuille Menu pour la date). Chaque mois, je crée la feuille de collecte du mois (Clic droit sur l'onglet Déplacer ou copie, créer une copie) qui sera envoyée pour mise à jour par le destinataire.
    Avant d'être envoyées, ces feuilles modèles (classeur .xlsx avec 1 seule feuille) sont stockées dans un répertoire "MàJ". Je souhaite supprimer tous les liens des feuilles de collecte du mois avec le classeur modèle avant de les envoyer aux destinataires.
    J'ai recherché un code VBA pour supprimer toutes ces liaisons mais sans succès, et ça devient un peu compliqué pour moi!
    Pour résumer : J'ai 40 classeurs avec 1 seule feuille, chacune ayant une liaison avec son classeur modèle d'origine. Elles sont toutes dans un même répertoire "MàJ" et je souhaite une macro pour supprimer toutes les liaisons. Ca peut se faire manuellement, bien sûr, mais c'est fastidieux!
    Très cordialement

  2. #2
    Membre éclairé Avatar de Valtrase
    Homme Profil pro
    Jeune retraité...
    Inscrit en
    Janvier 2016
    Messages
    396
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 65
    Localisation : France, Pyrénées Orientales (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Jeune retraité...
    Secteur : Boutique - Magasin

    Informations forums :
    Inscription : Janvier 2016
    Messages : 396
    Points : 696
    Points
    696
    Par défaut
    Bonjour,
    Ormis le fait qu'il va falloir boucler sur l'ensemble des classeurs, la réponse à votre question se trouve dans la gestion des liens des classeurs. et du type de lien que vous devez traiter.
    Jean-Paul sous Office 365 et Windows 10/11 (Intel I7 16Go)

    Si vous avez trouvé réponse à votre question penser à la passer en Vous avez aimé la discussion alors un fait toujours plaisir.
    Le savoir n'a de valeur que s'il est partagé.
    La vérité de demain se nourrit de l'erreur d'hier. Antoine de Saint-Exupéry

  3. #3
    Membre éprouvé
    Inscrit en
    Décembre 2002
    Messages
    818
    Détails du profil
    Informations forums :
    Inscription : Décembre 2002
    Messages : 818
    Points : 1 286
    Points
    1 286
    Par défaut
    Bonjour, teste ce code:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    Sub SupprimerLiaisons()
     
        Dim dossier As String
        Dim fichier As String
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim lien As Variant
     
     
        dossier = "C:\chemin\vers\votre\dossier\MàJ\"
     
        ' Boucle sur chaque fichier .xlsx dans le répertoire '
        fichier = Dir(dossier & "*.xlsx")
        Do While Len(fichier) > 0
            Set wb = Workbooks.Open(dossier & fichier)
     
            ' Boucle sur chaque feuille de calcul dans le classeur '
            For Each ws In wb.Worksheets
                ' Suppression des liaisons externes '
                ws.Cells.BreakLinks Name:=xlExcelLinks
            Next ws
     
            wb.Save
            wb.Close
     
            ' Fichier suivant '
            fichier = Dir
        Loop
     
        MsgBox "Toutes les liaisons externes ont été supprimées.", vbInformation
     
    End Sub

  4. #4
    Membre du Club
    Homme Profil pro
    Suivi Evaluation
    Inscrit en
    Novembre 2010
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vaucluse (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Suivi Evaluation
    Secteur : Conseil

    Informations forums :
    Inscription : Novembre 2010
    Messages : 54
    Points : 51
    Points
    51
    Par défaut VBA : Supprimer les liaisons
    Franc, bonjour,
    Et merci pour le code mais je n'obtiens pas ce que je souhaite. peut être ai je mal compris?
    J'ai mis une feuille en exemple FCM-P2106_2202R.
    Cette feuille est créée à partir du classeur central avec Déplacer-copier (clic-droit sur l'onglet). Elle a donc un lien avec son classeur d'origine, en l'occurence PACTE-SSE_FCM V04 et pour simplifier, je souhaite supprimer ce lien.
    Lorsque j'applique la macro, ça tourne sans problème mais lorsque je vérifie sur la feuille d'exemple FCM-P2106_2202R la liaison est toujours là!
    FCM-P2106_ 2202R.xlsx
    J'ai recherché sur Internet et j'ai trouve ceci : utiliser : ws.Cells.BreakLinks Type:=xlLinkTypeExcelLinks mais cela ne change rien non plus!
    Apparemment, il faut une commande spéciale par type de lien! En l'occurence, ici, c'est un lien vers un autre classeur Excel.
    Ca dépasse largement mes compétences, je reste à l'écoute!
    Merci
    Nouveau : Je viens de trouver un code qui fonctionne! Mais je ne sais l'insérer proprement dans votre code de départ qui balaie tous les feuilles de tous les classeurs du répertoire
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    Sub CouperLiens()
        Dim wbActif As Workbook
        Dim lien As Variant
     
        Set wbActif = Application.ActiveWorkbook
     
        If Not IsEmpty(wbActif.LinkSources(Type:=xlLinkTypeExcelLinks)) Then
            For Each lien In wbActif.LinkSources(Type:=xlLinkTypeExcelLinks)
                wbActif.BreakLink lien, Type:=xlLinkTypeExcelLinks
            Next lien
        End If
    End Sub
    GDM84480

  5. #5
    Membre éclairé Avatar de Valtrase
    Homme Profil pro
    Jeune retraité...
    Inscrit en
    Janvier 2016
    Messages
    396
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 65
    Localisation : France, Pyrénées Orientales (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Jeune retraité...
    Secteur : Boutique - Magasin

    Informations forums :
    Inscription : Janvier 2016
    Messages : 396
    Points : 696
    Points
    696
    Par défaut
    Bonjour,
    @gdmeunier
    La question est de savoir à quel moment vous voulez supprimer le lien ?
    Le code que vous a donné Franc supprime les liens des classeurs contenus dans un dossier. Il faut donc lui donner le bon chemin.
    Et pour être plus sûr remplacer : fichier = Dir(dossier & "*.xlsx") par : fichier = Dir(dossier & "*.xls*")
    Sinon en reprenant le code de Franc cela doit donner quelque chose comme cela :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    Sub SupprimerLiaisons()
     
        Dim dossier As String
        dossier = "C:\chemin\vers\votre\dossier\MàJ\"
     
        ' Boucle sur chaque fichier .xlsx dans le répertoire '
        Dim fichier As String
        fichier = Dir(dossier & "*.xls*")
        Do While Len(fichier) > 0
            Dim Classeur As Excel.Workbook
            Set Classeur = Workbooks.Open(dossier & fichier)
            With Classeur
                If Not IsEmpty(.LinkSources(Type:=xlLinkTypeExcelLinks)) Then
                    Dim lien As Variant
                    For Each lien In .LinkSources(Type:=xlLinkTypeExcelLinks)
                        .BreakLink lien, Type:=xlLinkTypeExcelLinks
                    Next lien
                End If
     
                .Save
                .Close
            End With
            If Not Classeur Is Nothing Then Set Classeur = Nothing
            ' Fichier suivant '
            fichier = Dir
        Loop
     
        MsgBox "Toutes les liaisons externes ont été supprimées.", vbInformation
     
    End Sub
    Jean-Paul sous Office 365 et Windows 10/11 (Intel I7 16Go)

    Si vous avez trouvé réponse à votre question penser à la passer en Vous avez aimé la discussion alors un fait toujours plaisir.
    Le savoir n'a de valeur que s'il est partagé.
    La vérité de demain se nourrit de l'erreur d'hier. Antoine de Saint-Exupéry

  6. #6
    Membre du Club
    Homme Profil pro
    Suivi Evaluation
    Inscrit en
    Novembre 2010
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vaucluse (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Suivi Evaluation
    Secteur : Conseil

    Informations forums :
    Inscription : Novembre 2010
    Messages : 54
    Points : 51
    Points
    51
    Par défaut VBA : Rompre liaison entre classeurs
    Valtrase, bonjour,
    Merci pour la précision *.xls* que je comprends. Il faut que je reteste en particulier le chemin. A suivre et merci. GDM84480

    Je viens de tester et retester, je n'y arrive pas.
    Mes classeurs Excel sont dans le répertoire : "C:\PACTE_SSE\B-DATA\REALISATIONC1C2\FCMC1C2_Modèle\Protéger" (avec copier le chemin)
    J'ai 2 codes :
    Le premier, que je dois placer dans un module pour un seul fichier fonctionne. Il supprime tous les liens du classeur dans lequel il se trouve.
    Sub CouperLiens()
    Dim wbActif As Workbook
    Dim lien As Variant

    Set wbActif = Application.ActiveWorkbook

    If Not IsEmpty(wbActif.LinkSources(Type:=xlLinkTypeExcelLinks)) Then
    For Each lien In wbActif.LinkSources(Type:=xlLinkTypeExcelLinks)
    wbActif.BreakLink lien, Type:=xlLinkTypeExcelLinks
    Next lien
    End If
    End SubLe second code qui me permet de sélectionner tous les classeurs dans ce répertoire, celui fournit par Frank, il tourne mais ne supprime aucun lien!
    J'ai essayé de combiner les 2, mais sans résultat.
    Sub SupprimerLiaisons2()
    Dim dossier As String
    Dim fichier As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lien As Variant

    dossier = "C:\PACTE_SSE\B-DATA\REALISATIONC1C2\FCMC1C2_Modèle\Protéger"

    ' Boucle sur chaque fichier .xlsx dans le répertoire '
    fichier = Dir(dossier & "*.xlsx")
    Do While Len(fichier) > 0
    Set wb = Workbooks.Open(dossier & fichier)

    ' Boucle sur chaque feuille de calcul dans le classeur '
    For Each ws In wb.Worksheets
    ' Suppression des liaisons externes '
    If Not IsEmpty(wb.LinkSources(Type:=xlLinkTypeExcelLinks)) Then
    For Each lien In wb.LinkSources(Type:=xlLinkTypeExcelLinks)
    wb.BreakLink lien, Type:=xlLinkTypeExcelLinks
    Next lien
    End If
    Next ws

    wb.Save
    wb.Close

    ' Fichier suivant '
    fichier = Dir
    Loop

    MsgBox "Toutes les liaisons externes ont été supprimées.", vbInformation

    End SubJe suppose qu'après avoir supprimer les liens, il y a Save mais la date du fichier ne change pas! Le code ne doit pas trouver le classeur (Protéger) qui contient les fichiers mais ce chemin est correct car j'ai une autre macro pour Protéger avec ce chemin et elle fonctionne.
    Je reste à l'écoute et désolé pour l'insistance (et mon manque de compréhension). GDM84480

  7. #7
    Membre éclairé Avatar de Valtrase
    Homme Profil pro
    Jeune retraité...
    Inscrit en
    Janvier 2016
    Messages
    396
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 65
    Localisation : France, Pyrénées Orientales (Languedoc Roussillon)

    Informations professionnelles :
    Activité : Jeune retraité...
    Secteur : Boutique - Magasin

    Informations forums :
    Inscription : Janvier 2016
    Messages : 396
    Points : 696
    Points
    696
    Par défaut
    Bonjour,
    Je vois d'une part que le chemin est :
    dossier = "C:\PACTE_SSE\B-DATA\REALISATIONC1C2\FCMC1C2_Modèle\Protéger"
    D'autre part :
    fichier = Dir(dossier & "*.xlsx")
    et enfin :
    Set wb = Workbooks.Open(dossier & fichier)
    Cela veut dire que :
    • On ne trouvera que les fichiers "xlsx"
    • Si mon fichier se nomme "MonFichier.xlsx" le chemin complet sera : C:\PACTE_SSE\B-DATA\REALISATIONC1C2\FCMC1C2_Modèle\ProtégerMonfichier.xlsx" Bon courage pour Trouver le fichier...


    LA QUESTION QUE JE ME POSE POURQUOI NE PAS REPRENDRE LE CODE QUE J'AI FOURNIS EN REMPLAÇANT JUSTE LE CHEMIN.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    Sub SupprimerLiaisons()
     
        Dim FullPath As String
        FullPath = "C:\PACTE_SSE\B-DATA\REALISATIONC1C2\FCMC1C2_Modèle\Protéger\"
        'FullPath = "D:\Utilisateurs\Valtrase\Desktop\Saves\"
        ' Boucle sur chaque fichier .xlsx dans le répertoire '
        Dim FileName As String
        FileName = Dir(FullPath & "*.xls*", vbNormal)
        Do While Len(FileName) > 0
            Dim Classeur As Excel.Workbook
            Set Classeur = Workbooks.Open(FullPath & FileName, xlUpdateLinksNever)
            With Classeur
                Debug.Print "Traitement du classeur : "; FullPath & FileName
     
                If Not IsEmpty(.LinkSources(Type:=xlLinkTypeExcelLinks)) Then
                    Dim lien As Variant
                    For Each lien In .LinkSources(Type:=xlLinkTypeExcelLinks)
                        .BreakLink lien, Type:=xlLinkTypeExcelLinks
                    Next lien
     
                    Debug.Print "Supression des liens"
                Else
                    Debug.Print "Pas de liens pour ce classeur"
                End If
     
                .Save
                .Close
                Debug.Print vbNullString
            End With
            If Not Classeur Is Nothing Then Set Classeur = Nothing
            ' Fichier suivant '
            FileName = Dir
        Loop
        MsgBox "Toutes les liaisons externes ont été supprimées.", vbInformation
    End Sub
    Je viens de faire un test en réel sur trois fichiers et tout est OK : (cf. screenshoot ci-dessous)
    Nom : 000503.png
Affichages : 54
Taille : 5,3 Ko
    Et sur la fenêtre d'exécution :
    Nom : 000504.png
Affichages : 52
Taille : 8,1 Ko
    Jean-Paul sous Office 365 et Windows 10/11 (Intel I7 16Go)

    Si vous avez trouvé réponse à votre question penser à la passer en Vous avez aimé la discussion alors un fait toujours plaisir.
    Le savoir n'a de valeur que s'il est partagé.
    La vérité de demain se nourrit de l'erreur d'hier. Antoine de Saint-Exupéry

  8. #8
    Membre du Club
    Homme Profil pro
    Suivi Evaluation
    Inscrit en
    Novembre 2010
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vaucluse (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Suivi Evaluation
    Secteur : Conseil

    Informations forums :
    Inscription : Novembre 2010
    Messages : 54
    Points : 51
    Points
    51
    Par défaut VBA - Suppression des liaisons entre feuilles
    Grand merci!!
    Effectivement c'était simplement l'adresse du répertoire. J'avis oublié le \ final!
    Erreur de débutant
    Encore merci à Franc et Valtrase.
    Et bravo à Developpez.net!

  9. #9
    Membre chevronné
    Profil pro
    Inscrit en
    Juillet 2006
    Messages
    1 219
    Détails du profil
    Informations personnelles :
    Localisation : France, Paris (Île de France)

    Informations forums :
    Inscription : Juillet 2006
    Messages : 1 219
    Points : 1 785
    Points
    1 785
    Par défaut
    Salut,

    Histoire de s'affranchir de ce genre d'étourderie assez courante,
    je suggère de passer par la librairie FSO qui est capable d'identifier un dossier, qu'un antislash final soit présent ou pas dans son chemin:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    Public Function GetFilesList(ByVal Path As string, ByVal ExtentionFilter As string) As Collection
        Dim Fso as Object    '// Scripting.FileSystemObject
        Set Fso = CreateObject("Scripting.FileSystemObject")
     
        Dim Folder As Object    '// Scripting.Folder
        Set Folder = Fso.GetFolder(Path)
     
        Dim List As Collection
        Set List = New collection
     
        Dim File As Object    '// Scripting.File
        For Each File in Folder.Files
            If(Fso.GetExtentionName(File.Name) Like ExtentionFilter) Then
                List.add File.Path
            End If
        Next
        Set GetFilesList = List
    End Function
    De plus, la fonction Dir ne "voit pas" les fichiers cachés, ce qui peut être problématique.

    Exemples d'appel:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    Dim List As Collection
    Set List = GetFilesList("C:\PACTE_SSE\B-DATA\REALISATIONC1C2\FCMC1C2_Modèle\Protéger", "xls*")
     
    Dim List As Collection
    Set List = GetFilesList("C:\PACTE_SSE\B-DATA\REALISATIONC1C2\FCMC1C2_Modèle\Protéger\", "xls*")

  10. #10
    Membre du Club
    Homme Profil pro
    Suivi Evaluation
    Inscrit en
    Novembre 2010
    Messages
    54
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vaucluse (Provence Alpes Côte d'Azur)

    Informations professionnelles :
    Activité : Suivi Evaluation
    Secteur : Conseil

    Informations forums :
    Inscription : Novembre 2010
    Messages : 54
    Points : 51
    Points
    51
    Par défaut VBA : Suppression liens entre classeurs
    Deedolith, merci pour ces précisions, mais là il faut que je réfléchisse un peu! Très cordialement GDM84480

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 24
    Dernier message: 10/10/2022, 13h55
  2. [Toutes versions] VBA pour supprimer automatique les lignes dont les montants s'annulent
    Par sia1212 dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 01/03/2022, 18h44
  3. [AC-2007] Code pour supprimer tous les fichiers, sous-dossiers d'un dossier
    Par lio33 dans le forum VBA Access
    Réponses: 2
    Dernier message: 07/04/2015, 19h26
  4. [Toutes versions] Renommer automatiquement les noms des feuilles excel
    Par anneso9 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 13/06/2011, 08h56
  5. [VBA] code pour recherche automatique de données
    Par lg022 dans le forum VBA Access
    Réponses: 3
    Dernier message: 07/02/2007, 10h20

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo