Macro sans ouvrir les fichiers

Bonjours tout le monde

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 :

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

Bonjour

Essaye comme cela :

    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

    Next i
    End With
    End Sub

Amicalement

Nad

euh désolé ca ne marche pas

il bloque sur

".Hyperlinks(i).ScreenTip = " VERS:" & .Cells(i + 5, 1).Value"

et il affiche plus la liste des ficiher et les onglets..

j'ai que un fichier avec son lien.. sans l'ouvrir mais j'ai pu le reste..

Bonjour,

Cette procédure à adapter à ton code (peut-être par procédure nommée) te donne la lisye des onglets dans un classeur fermé

Sub nom_onglets_xlsfermé()
    Dim source As Object
    Dim calalogue As Object
    Dim onglet As Object
    Dim Fich As String

    Fich = "D:\documents\ nomduclasseur.xls" 'a adapter

    Set source = CreateObject("ADODB.Connection")
    Set calalogue = CreateObject("ADOX.catalog")
    Set onglet = CreateObject("ADOX.table")

    source.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fich & _
            ";Extended Properties=Excel 8.0;"

    Set calalogue.ActiveConnection = source
    For Each onglet In calalogue.Tables
        cellule(ligne, colonne) = onglet.Name ' a adapter
        ligne = ligne + 1 'implémente ici l'adresse de la cellule
    Next

    Set onglet = Nothing
    Set calalogue = Nothing
    source.Close
    Set source = Nothing
End Sub

Merci ca marche

mais je narrive pa à la metre dans ma macro...

en fait il faudrait que ce

-- 24 Mar 2010, 14:18 --

desole

en fait faudrait que ce soit intégré dans ma macro qui me liste fichier + onglet sans à avoir à ouvrir les fichier un par un pour pouvoir afficher les onglets... je sais pas si c'est clair...

en fait il faudrait que ce

Oui, et après ?

-- Mer Mar 24, 2010 2:18 pm --

en fait il faudrait que ce

Oui, et après ?

en fait c'est ca qui ouvre chaque fichier ?

Workbooks.Open Cells (...)  ActiveWorkbook.Close

ca existe pas "Workbooks.Read" ^^ ? pour que ca lise sans ouvrir les fichiers...

je trouve pas de solution... et c'est pas à défaut de chercher

Re,

je ne sais pas si c'est à Nad ou à moi que tu réponds...

la procédure exemple que je t'ai donné répertorie le nom des onglets d'un classeur restant fermé; tu n'as pas alors besoin de workbook.open...

(Le terme source.open qui est empolyé dans ma macro indique qu'on ouvre une connexion et non un classeur...)

Une fois que tu connais le nom complet du classeur dans ta boucle(chemin+nom)

For i = 1 To .FoundFiles.Count

next

tu ouvres la connexion et tu restitue dans les cellules de ton choix pour créer le lien hypertexte

mais quelque soit la solution tu gagneras énormément de temps en incluant cette ligne avant les restitutions

application.screenupdating=false

re

c'etait bien à toi que je repondais, mais je vois pas comment integrer ton code à ce que j'ai fait...

parceque c'est la macro qui me liste le nom de tout les classeurs et dans la boucle c'est tout les onglets de tout ces fichiers que je voudrais.. donc je peux pas prevoir leur chemin...

j'essai encore de l'integrer à la mienne mais jai jamais vraiment reussi à combiner 2 macros...

et tu vois ca ou ? "application.screenupdating=false"

Cordialement

Bonjour

pour le screen updating, tu le met en debut de macro et tu le mets aussi a la fin mais =true.

ça te suspend l'actualisation de l'affichage et ainsi tu gagne des ressources.....et du temps.

cordialement

bonjour maguetlolo

ah oki ca sert à ca ! merci

et par hasard t'aurais pas une idée pour éviter d'ouvrir chaque fichier quand je lance cette macro ?

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

A = ActiveWorkbook.Name
Application.ScreenUpdating = True
With Application.FileSearch
' adresse du répertoire
.LookIn = "G:\"
' 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
Application.ScreenUpdating = True
Next i
End With
End Sub

re

pour ta solution, mon niveau n'est pas suffisant mais les personnes qui t'on répondu ont les compétences suffisante et je pense que tu devrais suivre et approffondir leur solution, bien sur, il faut que tu essais d'adapter ta macro avec la leur, même si cela te gonfle au bout de 50 essais ratés .

essai encore et poste ce que tu as essayé de faire, même si ça te parait nul, premièrement tu progresseras et deuxiemement tu donneras un peu plus envie de t'aider qu'en disant "ca marche pas" .

Ne le prends pas mal, je ne suis pas la pour donner des leçons mais je connait les difficultés que l'on peut rencontrer lorsqu'on ne connait pas.

Bonne chance a toi.

-- Jeu Mar 25, 2010 10:42 am --

re

pour ta solution, mon niveau n'est pas suffisant mais les personnes qui t'on répondu ont les compétences suffisante et je pense que tu devrais suivre et approffondir leur solution, bien sur, il faut que tu essais d'adapter ta macro avec la leur, même si cela te gonfle au bout de 50 essais ratés .

essai encore et poste ce que tu as essayé de faire, même si ça te parait nul, premièrement tu progresseras et deuxiemement tu donneras un peu plus envie de t'aider qu'en disant "ca marche pas" .

Ne le prends pas mal, je ne suis pas la pour donner des leçons mais je connait les difficultés que l'on peut rencontrer lorsqu'on ne connait pas.

Bonne chance a toi.

Bonjour,

Je croyais avoir envoyé un message mais apparemment...

Donc:

Il n'est pas nécessaire de remettre screenupdating à true à la fin de la macro si on rend la main au système...

La source: site de Laurent Longre, un des meilleurs excellien de la planète avec Walkenback, Pearson...

en espèrant que ce message soit accepté

re

ok, j'ai encore apris quelque chose, merci

cordialement

Rechercher des sujets similaires à "macro ouvrir fichiers"