Macro pour lire et non ouvrir chaque fichiers

31toto

XLDnaute Junior
Bonjours tout le monde

J'aurai besoin d'aide...
J'ai fait une macro qui permet de lister des fichiers d'un dossier avec liens hypertexte et à coté la liste des onglets présent dans chaque fichier, voici le code :

Code:
Sub test_import_noms_dossiers()
Dim i, j, k As Integer
Dim A As String

A = ActiveWorkbook.Name

With Application.FileSearch
' adresse du répertoire
.LookIn = "G:\DT"
' type ou nom du fichier
.Filename = "*.xls"
' recherche dans les sous-dossiers
.SearchSubFolders = True
' executer la recherche
.Execute
' insertion dans le classeur excel
j = Range("r_deb_tab").Row
For i = 1 To .FoundFiles.Count
    Cells(j, 1) = .FoundFiles(i)
        With ActiveSheet
            .Hyperlinks.Add Anchor:=.Cells(j, 1), _
            Address:=.Cells(j, 1), _
            TextToDisplay:=.Cells(j, 1).Value
            .Hyperlinks(i).ScreenTip = " VERS:" & .Cells(i + 5, 1).Value
        End With
    Workbooks.Open Cells(j, 1).Value, , True
    For k = 1 To Sheets.Count
        Workbooks(A).Sheets(1).Cells(j, 2).Value = Sheets(k).Name
        j = j + 1
    Next k
    ActiveWorkbook.Close
Next i
End With
End Sub

est-ce que ca serait possible de faire la meme chose mais sans que ca ouvre chaque fichier pour trouver les onglets ?
parce que c'est des fichiers compliqué qui necessite une mise a jour à chaque foi qu'on les ouvre, donc si on peut éviter de les ouvrir ca serait quand meme beacoup mieux !!
vous en pensez quoi ? c'est faisable ?

Merci d'avance
 

Pièces jointes

  • exemple.zip
    21.5 KB · Affichages: 44
  • exemple.zip
    21.5 KB · Affichages: 43
  • exemple.zip
    21.5 KB · Affichages: 38

mromain

XLDnaute Barbatruc
Re : Macro pour lire et non ouvrir chaque fichiers

bonjour 31toto,

Une autre solution possible serait de désactiver les évènements et le calcul automatique avant d'ouvrir ces classeurs et de les réactiver après avoir traiter les classeur.
Application.Calculation
Application.EnableEvents

a+
 

31toto

XLDnaute Junior
Re : Macro pour lire et non ouvrir chaque fichiers

merci pour cette reponse rapide :):)
mais je comprend pas ce que tu veux dire...
j'ai reussi à faire cette macro mais c'était un mix, je suis quand meme pas tres doué...
j'ai essayé "Workbooks.Open Cells(j, 1).Value, , True" True-False mais ca ne change rien...
c'est à rajouter tes fonctions ?
 

mromain

XLDnaute Barbatruc
Re : Macro pour lire et non ouvrir chaque fichiers

re bonjour,

avec un truc du genre :
Code:
[B]Public Sub test_import_noms_dossiers()
Dim mem1 As Long, mem2 As Long, mem3 As Long
    'mémoriser/désactiver les options d'excel
    mem1 = Application.Calculation: Application.Calculation = xlCalculationManual
    mem2 = Application.EnableEvents: Application.EnableEvents = False
    mem3 = Application.ScreenUpdating: Application.ScreenUpdating = False
    
    'exécuter la macro
    On Error Resume Next
     test_import_noms_dossiers_int
    On Error GoTo 0
    
    'rétablir les options d'excel
    Application.Calculation = mem1
    Application.EnableEvents = mem2
    Application.ScreenUpdating = mem3

End Sub[/B]


Private Sub test_import_noms_dossiers_int()
Dim i, j, k As Integer
Dim A As String

A = ActiveWorkbook.Name

With Application.FileSearch
' adresse du répertoire
.LookIn = "G:\DT"
' type ou nom du fichier
.Filename = "*.xls"
' recherche dans les sous-dossiers
.SearchSubFolders = True
' executer la recherche
.Execute
' insertion dans le classeur excel
j = Range("r_deb_tab").Row
For i = 1 To .FoundFiles.Count
    Cells(j, 1) = .FoundFiles(i)
        With ActiveSheet
            .Hyperlinks.Add Anchor:=.Cells(j, 1), _
            Address:=.Cells(j, 1), _
            TextToDisplay:=.Cells(j, 1).Value
            .Hyperlinks(i).ScreenTip = " VERS:" & .Cells(i + 5, 1).Value
        End With
    Workbooks.Open Cells(j, 1).Value, , True
    For k = 1 To Sheets.Count
        Workbooks(A).Sheets(1).Cells(j, 2).Value = Sheets(k).Name
        j = j + 1
    Next k
    ActiveWorkbook.Close
Next i
End With
End Sub

à tester, je ne suis pas sûr que ça marche.

a+
 

31toto

XLDnaute Junior
Re : Macro pour lire et non ouvrir chaque fichiers

merci beaucoup mromain !! ca marche !!
ca m'affiche juste les fenetres de mise à jour pour chaque fichier, mais tu les vois pas s'ouvrir c'est deja beaucoup mieux :) encore merci !

et par hasard une ptite diée pour encore l'améliorer et éviter ce message ?
du style faire un "ne pa mettre à jour à tous" ? ou le pré programmer dans la macro... quest ce que t'en pense ? sinon pas grave

encore merci !!!
 

mromain

XLDnaute Barbatruc
Re : Macro pour lire et non ouvrir chaque fichiers

merci beaucoup mromain !! ca marche !!
ca m'affiche juste les fenetres de mise à jour pour chaque fichier, mais tu les vois pas s'ouvrir c'est deja beaucoup mieux :) encore merci !

et par hasard une ptite diée pour encore l'améliorer et éviter ce message ?
du style faire un "ne pa mettre à jour à tous" ? ou le pré programmer dans la macro... quest ce que t'en pense ? sinon pas grave

encore merci !!!


Toujours sans tester, regarde du coté de
Application.DisplayAlerts
à appliquer dans le même principe que les autres.

a+
 

31toto

XLDnaute Junior
Re : Macro pour lire et non ouvrir chaque fichiers

:D merci je l'ai rajouté comme les autres j'ai essayé avec TRUE et FALSE
mais ca ne change rien....

Code:
im mem1 As Long, mem2 As Long, mem3 As Long, mem4 As Long
    'mémoriser/désactiver les options d'excel
    mem1 = Application.Calculation: Application.Calculation = xlCalculationManual
    mem2 = Application.EnableEvents: Application.EnableEvents = False
    mem3 = Application.ScreenUpdating: Application.ScreenUpdating = False
    mem4 = Application.DisplayAlerts: Application.DisplayAlerts = xlCalculationManual
    
    'exécuter la macro
    On Error Resume Next
     test_import_noms_dossiers_int
    On Error GoTo 0
    
    'rétablir les options d'excel
    Application.Calculation = mem1
    Application.EnableEvents = mem2
    Application.ScreenUpdating = mem3
    Application.DisplayAlerts = mem4

... merci encore !
 

mromain

XLDnaute Barbatruc
Re : Macro pour lire et non ouvrir chaque fichiers

re,

normalement, c'est avec False :
Code:
mem4 = Application.DisplayAlerts: Application.DisplayAlerts = False

Si ça ne marche pas, je ne vois pas trop (c'est pas facile sans le fichier).

a+
 

31toto

XLDnaute Junior
Re : Macro pour lire et non ouvrir chaque fichiers

j'ai essayé ca fait pareil...
je te renvoi mon exemple, mais ca se voit pas : en vrai ya une mise à jour à ne pas faire a chaque foi que j'ouvre les fichiers type (A1, B2,...)
 

mromain

XLDnaute Barbatruc
Re : Macro pour lire et non ouvrir chaque fichiers

Bonjour 31toto.

Sous Excel 2007 la fonction FileSearch ne marche pas.
Du coup, j'ai modifié ton code (enlevé FileSearch), la macro tourne, mais je n'ai pas rencontré le problème de "mise à jour"...

Il faudrait que tu expliques un petit peu plus ce point.

Code:
Public Sub test_import_noms_dossiers()
Dim mem1 As Long, mem2 As Long, mem3 As Long
    'mémoriser/désactiver les options d'excel
    mem1 = Application.Calculation: Application.Calculation = xlCalculationManual
    mem2 = Application.EnableEvents: Application.EnableEvents = False
    mem3 = Application.ScreenUpdating: Application.ScreenUpdating = False
    mem4 = Application.DisplayAlerts: Application.DisplayAlerts = False

    'exécuter la macro
    On Error Resume Next
     test_import_noms_dossiers_int
    On Error GoTo 0

    'rétablir les options d'excel
    Application.Calculation = mem1
    Application.EnableEvents = mem2
    Application.ScreenUpdating = mem3
    Application.DisplayAlerts = False
End Sub


Private Sub test_import_noms_dossiers_int()
Dim i, j, k As Integer
Dim A As String
Dim listeFichiers() As String, iFichiers As Long

listeFichiers = ListerFichiersXls(ThisWorkbook.Path)

A = ActiveWorkbook.Name
j = Range("r_deb_tab").Row
For iFichiers = LBound(listeFichiers) To UBound(listeFichiers)
    If listeFichiers(iFichiers) <> ThisWorkbook.Path & "\" & ThisWorkbook.Name Then
        Cells(j, 1) = listeFichiers(iFichiers)
            With ActiveSheet
                .Hyperlinks.Add Anchor:=.Cells(j, 1), _
                Address:=.Cells(j, 1), _
                TextToDisplay:=.Cells(j, 1).Value
                .Hyperlinks(iFichiers + 1).ScreenTip = " VERS:" & .Cells(iFichiers + 6, 1).Value
            End With
        Workbooks.Open Cells(j, 1).Value, , True
        For k = 1 To Sheets.Count
            Workbooks(A).Sheets(1).Cells(j, 2).Value = Sheets(k).Name
            j = j + 1
        Next k
        ActiveWorkbook.Close
    End If
Next iFichiers


Application.ScreenUpdating = True
End Sub



Private Function ListerFichiersXls(folderPath As String) As Variant
Dim listeExtensions
listeExtensions = Array("xls", "xlsx", "xlsm")
ListerFichiersXls = Split(PrivateGetFileFromFolder(folderPath, listeExtensions, True), ";")
End Function


Private Function PrivateGetFileFromFolder(folderPath As String, fileExtensions, checkSubFolder As Boolean) As String
Dim myFso As Object, myFolder As Object, curFolder As Object, curFile As Object
Dim curExt As String, tmpTab() As String
Dim i As Integer
    Set myFso = CreateObject("Scripting.FileSystemObject")
    Set myFolder = myFso.GetFolder(folderPath)
    
    For Each curFile In myFolder.Files
        tmpTab = Split(curFile.Name, ".")
        curExt = tmpTab(UBound(tmpTab))
        For i = LBound(fileExtensions) To UBound(fileExtensions)
            If UCase(curExt) Like UCase(fileExtensions(i)) Then
                PrivateGetFileFromFolder = PrivateGetFileFromFolder & curFile.Path & ";"
                Exit For
            End If
        Next i
    Next curFile
    If checkSubFolder = True Then
        For Each curFolder In myFolder.SubFolders
            PrivateGetFileFromFolder = PrivateGetFileFromFolder & PrivateGetFileFromFolder(curFolder.Path, fileExtensions, checkSubFolder)
        Next curFolder
    End If
    
    Set myFolder = Nothing: Set myFso = Nothing
    If Right(PrivateGetFileFromFolder, 1) = ";" Then PrivateGetFileFromFolder = Left(PrivateGetFileFromFolder, Len(PrivateGetFileFromFolder) - 1)
End Function

a+
 

31toto

XLDnaute Junior
Re : Macro pour lire et non ouvrir chaque fichiers

merci de me répondre !

en fait mes fichiers excel quand tu les ouvre il demande une mise à jour (c'est un fichier qui passe de service en service dans mon entreprise) mais pour moi je dois toujurs les refuser c'est mise à jour

dans la marco de départ, ca mouvrait chaque fichier donc javais la fenetre de mise à jour, ensuite quelqu'un a reussi à éviter de les ouvrir mais j'ai toujours la liste des fenetre qui s'affiche ou je dit ne pas metre à jour, mais j'ai bcp de fichier donc ca fait bcp de fenetre qui s'ouvre
j'aimerais enfait savoir si c'est possible de dire la réponse à cette question uen bonne foi pour toute et comme ca des qu'elle se pose la marco repond toute seul.. ou davoir une foi la fenetre et de faire "ne pa metre à jour pour tous".. tu vois ce que je veux dire ?
sinon j'ai essayé ta macro ca change pas de ce que j'avais avant mais merci quand meme celle là marche pour 2007 :)
 

mromain

XLDnaute Barbatruc
Re : Macro pour lire et non ouvrir chaque fichiers

merci de me répondre !

en fait mes fichiers excel quand tu les ouvre il demande une mise à jour (c'est un fichier qui passe de service en service dans mon entreprise) mais pour moi je dois toujurs les refuser c'est mise à jour

dans la marco de départ, ca mouvrait chaque fichier donc javais la fenetre de mise à jour, ensuite quelqu'un a reussi à éviter de les ouvrir mais j'ai toujours la liste des fenetre qui s'affiche ou je dit ne pas metre à jour, mais j'ai bcp de fichier donc ca fait bcp de fenetre qui s'ouvre
j'aimerais enfait savoir si c'est possible de dire la réponse à cette question uen bonne foi pour toute et comme ca des qu'elle se pose la marco repond toute seul.. ou davoir une foi la fenetre et de faire "ne pa metre à jour pour tous".. tu vois ce que je veux dire ?
sinon j'ai essayé ta macro ca change pas de ce que j'avais avant mais merci quand meme celle là marche pour 2007 :)
re bonjour,

Cette fenêtre ne s'affichant pas chez moi, difficile de te répondre...
De plus, je m'arrange pour ne jamais utiliser les liens entres fichiers, du coup, je n'ai jamais été confronté à ce problème. Peut-être que d'autres XLDiens pourront te répondre...

Bon courage ;)
 

31toto

XLDnaute Junior
Re : Macro pour lire et non ouvrir chaque fichiers

je sais pas faire pour que tu la voi..
c'est surement pas faisable
peutetre que le simple fait de lire dans un fichier fermé, declenche le problem de mettre à jour... je sais pas
en tout k c mieu qu'avant malgre toute les fentres à fermer a chaque foi

merci d'avoir essayé
 

31toto

XLDnaute Junior
Re : Macro pour lire et non ouvrir chaque fichiers

voila un exemple ou on voit les mise à jours...
j'espere que ca vous aidera
ca serait super si jai plus ces messages
pck j'ai plus de 400 fichiers, donc qd je lance la macro 400 messages c'est pas tip top...
merci d'avance !
en esperant que vou pouvez m'aider, bonne journée !
 

Pièces jointes

  • Forum.zip
    21 KB · Affichages: 48
  • Forum.zip
    21 KB · Affichages: 42
  • Forum.zip
    21 KB · Affichages: 40

Discussions similaires

Réponses
7
Affichages
355

Statistiques des forums

Discussions
312 413
Messages
2 088 199
Membres
103 764
dernier inscrit
nissassa