XL 2016 Rompre les liens avec les requêtes et autres liens

[ZZ59264]

Bonjour à tous,

Suite au code fourni par Job75 que je salue au passage, pourriez vous regarder le code proposé car en l'utilisant les liens avec mes requêtes est toujours présent et il y a également un lien créer avec le fichier source :

Sub Creer_Fichiers_Classes()
Dim F As Worksheet, classe$, P As Range, i As Variant, s, chemin$, c As Range, w As Worksheet, o As Object, nom As Name, sup As Boolean
'---préparation---
Set F = Feuil1 'CodeName
classe = F.DrawingObjects(Application.Caller).Text 'les boutons doivent avoir des noms différents
Set P = F.ListObjects(1).Range 'tableau structuré
i = Application.Match(classe, P.Columns(3), 0) 'EQUIV
If IsError(i) Then MsgBox classe & " non trouvée !", 48: Exit Sub
Set P = P(i, 1).Resize(Application.CountIf(P.Columns(3), classe), P.Columns.Count)
If Application.CountIf(P.Columns(5), "OK") <> P.Rows.Count Then MsgBox "Il faut que tous les onglets de " & classe & " soient validés par OK...": Exit Sub
'---création des dossiers s'ils n'existent pas---
s = Split(P(1, 4), "\")
chemin = s(0) & "\" 'lecteur
For i = 1 To UBound(s)
    chemin = chemin & s(i) & "\"
    If Dir(chemin, vbDirectory) = "" Then MkDir chemin
Next i
'---création des fichiers---
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier a déjà été créé
For Each c In P.Columns(1).Cells
    Set w = ThisWorkbook.Sheets(CStr(c))
    w.Visible = xlSheetVisible 'si la feuille est masquée
    Application.EnableEvents = False 'désactive les évènements
    If c(1, 2) <> c(0, 2) Then 'compare avec le nom de fichier au-dessus
        w.Copy 'crée un nouveau document
    Else
        w.Copy After:=ActiveSheet 'ajoute la feuille copiée
    End If
    Application.EnableEvents = True 'réactive les évènements
    For Each o In ActiveSheet.PivotTables 'TCD
        With o.TableRange2
            s = .Value 'mémorise les valeurs
            .ClearContents 'efface le TCD
            .Value = s 'restitue les valeurs
        End With
    Next o
    For Each o In ActiveSheet.ListObjects 'tableaux structurés
        o.Unlist 'convertit en plage
    Next o
    Range(w.UsedRange.Address) = w.UsedRange.Value 'supprime les formules
    If c(1, 2) <> c(2, 2) Then 'compare avec le nom de fichier au-dessous
    
On Error Resume Next
 For Each nom In ActiveWorkbook.Names
      If PréfixeFeuille(nom.Name) <> PréfixeFeuille(Mid$(nom.RefersTo, 2)) Then nom.Delete
 Next nom
 On Error GoTo 0
    
    
        Sheets(1).Select '1ère feuille
        ActiveWorkbook.SaveAs chemin & c(1, 2), 51 'enregistre avec l'extension .xlsx
        ActiveWorkbook.Close False 'ferme le document
    End If
Next c
End Sub

Merci d'avance,

Cordialement,

 

[ZZ59264]

Bonjour au forum,

Une âme charitable pour un début d'aide ?,

Merci d'avance,

Cordialement,

 

[ZZ59264]

Bonsoir à tous,

Afin de faire avancer mon problème je vous le fichier en question,

lorsque je clique sur le bouton classe 1, les onglets A et WA sont importes sur un nouveau fichier mais le problème c'est que je souhaiterai supprimer les liens avec les requêtes et le lien avec le fichier d'origine,

Merci d'avance pour votre aide,

Cordialement,

 

[job75]

Bonjour ZZ59264,

Pour les requêtes je ne vois pas mais pour supprimer les liens hypertextes c'est facile :

    Range(w.UsedRange.Address) = w.UsedRange.Value 'supprime les formules
    Cells.Hyperlinks.Delete 'supprime les liens hypertextes

A+

 

[ZZ59264]

Bonjour Job75,

Merci pour votre retour, je l'ai testé sur le fichier joint mais j'ai toujours ce probleme de lien

Cordialement,

 

[chris]

Bonjour

Tu as une requête PowerQuery qui alimente le tableau de l'onglet BASE TCD REQUETE

Il suffit de la supprimer, le tableau subsistera sans lien avec quoi que ce soit.
Tu peux supprimer l'onglet ensuite si plus besoin

 

[ZZ59264]

Bonjour Chris,

Non l'onglet base tcd requete contient un tableau structué qui alimente la requête dont le résultat est présent par un tcd et par son affichage sur l’onglet WA,

La macro de création de fichier permet de déplacer les feuilles A & WA sur un nouveau ficher et c'est la que je ne veux plus de lien avec l'ancien fichier (requête,liens...) , tester si vous le pouvez le fichier ce sera plus parlant je pense,

Merci d'avance,

Cordialement,

 

[job75]

Bon j'ai été voir sur le web pour supprimer les requêtes :

    For Each o In ActiveWorkbook.Connections
        o.Delete
    Next o

 

[ZZ59264]

Bonjour Job75,

Après teste cela fonctionne,

Merci beaucoup, il me reste plus que cette fameuse liaison qui persiste?

Cordialement,

 

[job75]

Quelle liaison ? pour le lien hypertexte j'ai donné la solution.

 

[ZZ59264]

Bonjour Job 75, oui le lien hypertexte disparait mais il me met à l'ouverture du fichier créer :

 

[ZZ59264]

Et si je vais dans donner modifier les liens, il y a une liaison avec mon fichier d'origine, que je n'arrive pas à rompre

 

[job75]

Chez moi il n'y a pas de lien sur le fichier créé, testez le fichier joint.

 

[ZZ59264]

Bonsoir jOB75?

Effectivement j'ai tester et ça fonctionne, je vais donc voir sur mon fichier de travail, car il me met une liaison,

Merci,

Cordialement,

 

[ZZ59264]

Bonsoir jOB75?

Effectivement j'ai tester et ça fonctionne, je vais donc voir sur mon fichier de travail, car il me met une liaison,

Merci,

Cordialement,

Bonsoir Job75,

Après une heure de recherche, je rejoins le fichier pour test, je sais pourquoi le lien se créer sur mon fichier original et je l'ai transposé sur le fichier test,

En fait la cellule G2 de l'onglet WA à pour référence une liste de données de la feuille en têtes, et ce serait donc ces cellules de mon fichier de travail qui sont à l'origine de mes liaisons,

Le passage de votre macro de départ pour la suppression des noms était écrit comme ceci :

        For Each nom In ActiveWorkbook.Names
            sup = True
            For Each F In ActiveWorkbook.Worksheets
                If nom.Name Like F.Name & "!*" Or nom.Name Like "'" & F.Name & "'!*" Then sup = False
            Next F
            If sup Then nom.Delete 'supprime le nom sauf s'il est défini dans une feuille du document créé
        Next nom

Quand mon fichier bloquait avec les message d'erreur VBA non spécifié, on m'a suggérer cette façon plus rapide d'éxécution :

On Error Resume Next
 For Each nom In ActiveWorkbook.Names
      If PréfixeFeuille(nom.Name) <> PréfixeFeuille(Mid$(nom.RefersTo, 2)) Then nom.Delete
 Next nom
 On Error GoTo 0

avec deux fonctions :

Private Function PréfixeFeuille(ByVal Z As String) As String

   PréfixeFeuille = Left$(Z, PosPExcla(Z))

   End Function


Private Function PosPExcla(ByVal Z As String) As Long

Rem. Le nom de feuille peut contenir "!", et même "'!", ou commencer par "!", pourquoi pas, mais on ne peut

'    se contenter de chercher tout simplement le dernier "!" car la suite de Z peut aussi contenir "#REF!" !

   If Left$(Z, 1) = "'" Then PosPExcla = InStr(Replace(Mid$(Z, 2), "''", "??"), "'!") + 2 Else PosPExcla = InStr(Z, "!")

   End Function

Est ce que cela aurait une incidence sur la suppression de la liaison ou pas du tout?,

Sinon auriez vous une idée pour supprimer le lien qui se créer a cause des listes de données?,

Merci d'avance pour tout car je vous demande beaucoup de choses,

Cordialement,