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
 

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:

eriiic

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:

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 926
Membres
101 841
dernier inscrit
ferid87