VBA EXCEL: ne pas mettre à jour les liaisons entre les classeurs

Aragon10

XLDnaute Occasionnel
Bonjour,

J'utilise une macro qui extrait des valeurs à partir de plusieurs fichiers Excel.
Après avoir tester ce code sur mes 900 fichiers, un message ennuyant s'affichera tous les 2 secondes " ce classeur comporte des liaisons avec un autre classeur" et il me demande toujours de mettre à jour ou ne pas mettre à jour. y'a t-il un moyen d'integrer automatiquement "ne pas mettre à jour" pour tout les fichiers ?

Merci
 

Pierrot93

XLDnaute Barbatruc
Re : VBA EXCEL: ne pas mettre à jour les liaisons entre les classeurs

Bonjour,

Après avoir tester ce code sur mes 900 fichiers, un message ennuyant s'affichera tous les 2 secondes
sans voir le code ... pas facile... si tu utilises la méthode "open", utilises la avec l'argument "UpdateLinks"...

bon après midi
@+
 

Aragon10

XLDnaute Occasionnel
Re : VBA EXCEL: ne pas mettre à jour les liaisons entre les classeurs

Bonjour,



sans voir le code ... pas facile... si tu utilises la méthode "open", utilises la avec l'argument "UpdateLinks"...

bon après midi
@+
bon après-midi

ci dessous mon code :

Code:
Sub SearchFiles()
    Dim nbLignes As Long
    Dim Chemin
    nbLignes = Sheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row
 
    'Efface les données existantes avant de copier
    'Effacer cette ligne si ce n'est pas nécessaire
    Sheets("Feuil1").Range("A2:F" & nbLignes).EntireRow.Delete
    
    
    Chemin = BrowseForFolder("C:\Users\seb\Desktop")  'Changer le C pour autre chose si nécessaire
   
    
    ImportFiles Chemin   'Changer au besoin
    
    Sheets("Feuil1").Sort.SortFields.Add Key:=Range("A2:A" & nbLignes), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets("Feuil1").Sort
        .SetRange Range("A1:E" & nbLignes)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    MsgBox "Terminé"
End Sub
 
Sub ImportFiles(varPath As Variant)
    Dim nbLignes As Long
    Dim varFile As Variant
    Dim objColl As Collection
 
    On Error GoTo Erreur
 
    Set objColl = New Collection
 
    If Right(varPath, 1) <> "\" Then varPath = varPath & "\"
 
    varFile = Dir(varPath, vbDirectory + vbArchive)
    Do While varFile <> ""
        'Stocke le répertoire
        If GetAttr(varPath & varFile) = vbDirectory Then
            If Left(varFile, 1) <> "." Then
                objColl.Add varPath & varFile
            End If
 
        'Travailler avec le fichier
        ElseIf LCase(Right(varFile, 3)) = "xls" Or LCase(Right(varFile, 4)) = "xlsx" Then
            'Détermine la première ligne vide du classeur Résultats
            nbLignes = ThisWorkbook.Sheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row + 1
 
            'Ouvrir le fichier, copier les données et le fermer
            Workbooks.Open varPath & varFile, , True
 
            ActiveWorkbook.Sheets("Tab").Range("D13").Copy
            ThisWorkbook.Sheets("Feuil1").Range("A" & nbLignes).PasteSpecial xlPasteValues
 
            ActiveWorkbook.Close False
        End If
        varFile = Dir
    Loop
 
    For Each varFile In objColl
        ImportFiles varFile
    Next
 
    Set objColl = Nothing
 
    Exit Sub
 
Erreur:
    MsgBox Err.Number & vbCrLf & Err.Description
End Sub



Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object
     
    Set ShellApp = CreateObject("Shell.Application"). _
        BrowseForFolder(0, "Please choose a folder", 0, CVar(OpenAt))
     
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
    Set ShellApp = Nothing
     
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Erreur
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Erreur
        Case Else
            GoTo Erreur
    End Select
     
    Set ShellApp = Nothing
     
    Exit Function
     
Erreur:
    BrowseForFolder = False
     
End Function
 

Pierrot93

XLDnaute Barbatruc
Re : VBA EXCEL: ne pas mettre à jour les liaisons entre les classeurs

Re,

essaye peut être avec ceci :
Code:
Application.DisplayAlerts = False
Workbooks.Open varPath & varFile, , True
Application.DisplayAlerts = True
non testé....
 

Aragon10

XLDnaute Occasionnel
Re : VBA EXCEL: ne pas mettre à jour les liaisons entre les classeurs

Merci pour votre réponse.

Même après integration de votre code il m'affiche toujours de "mettre à jour" :confused:

Code:
Sub SearchFiles()
    Dim nbLignes As Long
    Dim Chemin
    nbLignes = Sheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row
 
    'Efface les données existantes avant de copier
    'Effacer cette ligne si ce n'est pas nécessaire
    Sheets("Feuil1").Range("A2:F" & nbLignes).EntireRow.Delete
    
    
    Chemin = BrowseForFolder("C:\Users\seb\Desktop")  'Changer le C pour autre chose si nécessaire
   
    
    ImportFiles Chemin   'Changer au besoin
    
    Sheets("Feuil1").Sort.SortFields.Add Key:=Range("A2:A" & nbLignes), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets("Feuil1").Sort
        .SetRange Range("A1:E" & nbLignes)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    MsgBox "Terminé"
End Sub
 
Sub ImportFiles(varPath As Variant)
    Dim nbLignes As Long
    Dim varFile As Variant
    Dim objColl As Collection
 
    On Error GoTo Erreur
 
    Set objColl = New Collection
 
    If Right(varPath, 1) <> "\" Then varPath = varPath & "\"
 
    varFile = Dir(varPath, vbDirectory + vbArchive)
    Do While varFile <> ""
        'Stocke le répertoire
        If GetAttr(varPath & varFile) = vbDirectory Then
            If Left(varFile, 1) <> "." Then
                objColl.Add varPath & varFile
            End If
 
        'Travailler avec le fichier
        ElseIf LCase(Right(varFile, 3)) = "xls" Or LCase(Right(varFile, 4)) = "xlsx" Then
            'Détermine la première ligne vide du classeur Résultats
            nbLignes = ThisWorkbook.Sheets("Feuil1").Cells(Rows.Count, "A").End(xlUp).Row + 1
 
            'Ouvrir le fichier, copier les données et le fermer
           Application.DisplayAlerts = False
           Workbooks.Open varPath & varFile, , True
           Application.DisplayAlerts = True
 
            ActiveWorkbook.Sheets("Tab").Range("D13").Copy
            ThisWorkbook.Sheets("Feuil1").Range("A" & nbLignes).PasteSpecial xlPasteValues
 
            ActiveWorkbook.Close False
        End If
        varFile = Dir
    Loop
 
    For Each varFile In objColl
        ImportFiles varFile
    Next
 
    Set objColl = Nothing
 
    Exit Sub
 
Erreur:
    MsgBox Err.Number & vbCrLf & Err.Description
End Sub



Function BrowseForFolder(Optional OpenAt As Variant) As Variant
    Dim ShellApp As Object
     
    Set ShellApp = CreateObject("Shell.Application"). _
        BrowseForFolder(0, "Please choose a folder", 0, CVar(OpenAt))
     
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
    Set ShellApp = Nothing
     
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Erreur
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Erreur
        Case Else
            GoTo Erreur
    End Select
     
    Set ShellApp = Nothing
     
    Exit Function
     
Erreur:
    BrowseForFolder = False
     
End Function
 
Dernière édition:

eriiiic

XLDnaute Barbatruc
Re : VBA EXCEL: ne pas mettre à jour les liaisons entre les classeurs

Bonjour,

et en allant modifier 'Données / modifier les liens... / Invite de démarrage...' ?
2015-06-17_00-07-13.jpg
eric
 
Dernière édition:

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas