Dresser liste d'un répertoire dans word

Résolu/Fermé

saratum - 1 avril 2009 à 21:33
Saratum - 2 avril 2009 à 20:06

Bonjour,
Merci encore pour tout l'aide que vous m'avez apporté dans les dernières semaine... Vraiment génial tous.... :)

Voila ce que je veux faire...

J'ai un répertoire contenant environ 100 fichiers excel .xlsm, avec sous répertoires (expirés, prospects, PA faites), et ces fichiers changent de façon continue....

J'aimerais en dresser la liste dans un fichier word ou html, avec un hyperlien qui me permette d'ouvrir chacun des fichiers à partir du fichier word ou html...

Puis, pour chacun des fichiers, je veux aller saisir les informations de 5 cellules de chacun de ces fichiers excel, et les afficher en arborescence sous le nom du fichier respectif.... J'aimerais que le contenu se mettent à jours automatiquement, et que le procédé soit totalement transparent....

Est ce faisable?
Comment faire?
Serais- je mieux d'utiliser access? dans les deux cas je n'y connais rien....

Merci

A voir également:

Dresser liste d'un répertoire dans word
Liste déroulante excel - Guide
Supprimer une page word - Guide
Espace insécable word - Guide
Organigramme word - Guide
Word gratuit - Guide

9 réponses

Réponse 1 / 9

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
2 avril 2009 à 07:28

Bonjour,
Excel pourait répondre à ce que tu veux mais c'est une gestion asser compliquée à mettre en place pour un débutant.
Rapatrier les noms des fichiers et en faire des liens hyperText est asser simple ensuite, pour rapatrier des cellules...
En ouvrant le classeur concerné... Aussi asser simple
En laissant le classeur fermer c'est plus compliquer.

soit, voilà une sub qui te fait tout et il ne faut pas en faire des HyperText, pour mémoriser les modif il faudra travailler à partir de la feuille.

Sub LireRepertoir()
'lire le répertoir et mettre les noms classeur dans une feuille excel
Dim fs, F, f1, S, sf
Dim Ext As String, Chemin As String
Dim T As String, Lig As Long, i As Integer
Dim FL1 As Worksheet
Dim FL2 As Worksheet
    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    Ext = "xls" 'adapter au type de fichier à lire
    Chemin = "E:\" 'adapter au répertoir où sont situés les fichiers.
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    Set FL1 = Sheets("Feuil1")
    Lig = 4
    For Each f1 In sf
        'tester l'extention
        If f1.Name <> ThisWorkbook.Name And Right(f1.Name, Len(Ext)) = Ext Then
            'Inscrire le chemin et le nom du classeur
            FL1.Cells(Lig, 2) = Chemin
            FL1.Cells(Lig, 3) = f1.Name
            'ouvrir le classeur
            Workbooks.Open Chemin & f1.Name
            Set FL2 = ActiveWorkbook.Sheets(1)
            'Entrer les 5 première cellules ligne 5
            For i = 1 To 5
                FL1.Cells(Lig, 3 + i) = FL2.Cells(5, i)
            Next i
            Workbooks(f1.Name).Close SaveChanges:=False
            Set FL2 = Nothing
            Lig = Lig + 1
        End If
    Next
    With Application
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

A+

Réponse 2 / 9

saratum
2 avril 2009 à 07:42

Merci Lermite222

Je vais travailler à partir ce ça... :) Merci...
je vais sans doute avoir quelques questions encore... :s... lol

Je n'ai pas trop compris par rapport au hypertexte... mais je crois qu'en aregistrant une macro, je pourrais sans doute me servir de ta variable du nom de fichier pour la faire inscrire... tk, je vais voir ce que je peux déchiffrer de tout ça... hihi

Merci encore..

Réponse 3 / 9

saratum
2 avril 2009 à 08:29

Je n'arrive pas à voir où dans le processus s'écris le nom du fichier hypertexte... et où je peux inscrire les données supplémentaires....

Exemple...
Dans le classeur où je roule la macro,
1, la macro efface la page actuelle....
2, la macro inscrit en A1: Propriété
en B1: Prix Demandé
C1: Prix à MRB choisi
D1: Numéro PA

Puis la macro débute la lecture, et inscris les informations du répertoire et des fichiers à partir de la ligne 3...

rangé A = Nom du fichier avec hypertext qui me permet d'ouvrir le classeur correspondant...
Rangé B = la donnée qui apparait dans le fichier, sous la feuille appelé 'IMMEUBLE' dans la cellule K32
Rangé C = la donnée qui est dans la feuille 'DÉCISIONS' en cellule E45
Rangé D= la donnée qui appareait en feuille 'Analyse d'Invest' cellule G2

Sub LireRepertoir()
' Touche de raccourci du clavier: Ctrl+k
'
'Formatage de feuille
Cells.Select
Selection.ClearContents
Range("A1").Select
ActiveCell.FormulaR1C1 = "Propriétés"
Columns("A:A").ColumnWidth = 33.71
Range("B1").Select
ActiveCell.FormulaR1C1 = "Prix demandé"
Range("C1").Select
ActiveCell.FormulaR1C1 = "PRIX à MRN Choisi"
Columns("B:C").Select
Selection.ColumnWidth = 17
Range("D1").Select
ActiveCell.FormulaR1C1 = "Numéro PA"
Columns("D:D").ColumnWidth = 12.57
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
'lire le répertoir et mettre les noms classeur dans une feuille excel
Dim fs, F, f1, S, sf
Dim Ext As String, Chemin As String
Dim T As String, Lig As Long, i As Integer
Dim FL1 As Worksheet
Dim FL2 As Worksheet
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
End With
Ext = "xlsm" 'adapter au type de fichier à lire
Chemin = "C:\Documents and Settings\Pat\My Documents\Remax\fiches client\Alain Pierre\Prospects" 'adapter au répertoir où sont situés les fichiers.
Set fs = CreateObject("Scripting.FileSystemObject")
Set F = fs.GetFolder(Chemin)
Set sf = F.Files
Set FL1 = Sheets("feuil1")
Lig = 4
For Each f1 In sf
'tester l'extention
If f1.Name <> ThisWorkbook.Name And Right(f1.Name, Len(Ext)) = Ext Then
'Inscrire le chemin et le nom du classeur
FL1.Cells(Lig, 2) = Chemin
FL1.Cells(Lig, 3) = f1.Name
'ouvrir le classeur
Workbooks.Open Chemin & f1.Name
Set FL2 = ActiveWorkbook.Sheets(1)
'Entrer les 5 première cellules ligne 5
For i = 1 To 5
FL1.Cells(Lig, 3 + i) = FL2.Cells(5, i)
Next i
Workbooks(f1.Name).Close SaveChanges:=False
Set FL2 = Nothing
Lig = Lig + 1
End If
Next
With Application
.EnableEvents = True
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub

Dans le programme... Set FL1 = Sheets("feuil1") feuil1 est dans le fichier liste ou dans les fichiers source?

Réponse 4 / 9

Raymond PENTIER Messages postés 58392 Date d'inscription lundi 13 août 2007 Statut Contributeur Dernière intervention 22 avril 2024 17 093
2 avril 2009 à 04:19

Bonjour.
Je crains que ni Excel ni Access ne puissent satisfaire à tes exigences.
Il faudrait de tourner vers les programmes spéciaux écrits pour ça ... Voir Google.

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 9

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
2 avril 2009 à 07:56

Le chemin et nom de fichier serra à reprendre dans la colonne B et C soit
Nom = cells(Ligne,2) & cells(Ligne,3)

Réponse 6 / 9

saratum
2 avril 2009 à 09:21

J'ai une erreur d'exécution 1004 à l'ouverture du fichier... probablement a cause de la longueur du nom de mes fichier....

Exemple de mes noms de fichiers....
3_MLS_8111776_24-32 Place du Marché Saint-Jean-sur-Richelieu J3B 2P4.xlsm

Sub LireRepertoir()
' Touche de raccourci du clavier: Ctrl+k

' Rend le processus invisible
    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

'Formatage de feuille
    Sheets("En Vigueur").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Propriétés"
    Columns("A:A").ColumnWidth = 55
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Prix demandé"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "PRIX à MRN Choisi"
    Columns("B:C").Select
    Selection.ColumnWidth = 17
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Numéro PA"
    Columns("D:D").ColumnWidth = 13
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Columns("E:E").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Sheets("En Vigueur").Select
    Cells.Select
    Selection.Copy
    Sheets("Expirés").Select
    Cells.Select
    ActiveSheet.Paste
    Sheets("PA Faites").Select
    Cells.Select
    ActiveSheet.Paste
    Sheets("En Vigueur").Select
    Application.CutCopyMode = False
    
'lire le répertoir et mettre les noms classeur dans la feuille En Vigueur
Dim fs, F, f1, S, sf
Dim Ext As String, Chemin As String
Dim T As String, Lig As Long, i As Integer
Dim FL1 As Worksheet
Dim FL2 As Worksheet
    
    Ext = "xlsm" 'type de fichier à lire
    Chemin = "C:\Documents and Settings\Pat\My Documents\Remax\fiches client\Alain Pierre\Prospects" 'répertoir où sont situés les fichiers.
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    Set FL1 = Sheets("En Vigueur")
    Lig = 4
    For Each f1 In sf
        'tester l'extention
        If f1.Name <> ThisWorkbook.Name And Right(f1.Name, Len(Ext)) = Ext Then
            'Inscrire le chemin et le nom du classeur
            FL1.Cells(Lig, 5) = Chemin
            FL1.Cells(Lig, 1) = f1.Name
            'ouvrir le classeur
            Workbooks.Open Chemin & f1.Name 'ligne où le débugueur m'indique l'erreur
            Set FL2 = ActiveWorkbook.Sheets(1)
            'Entrer les 5 première cellules ligne 5
            For i = 1 To 5
                FL1.Cells(Lig, 3 + i) = FL2.Cells(5, i)
            Next i
            Workbooks(f1.Name).Close SaveChanges:=False
            Set FL2 = Nothing
            Lig = Lig + 1
        End If
    Next
    With Application
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

Réponse 7 / 9

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
2 avril 2009 à 10:28

Non,
faut mettre un \ slash inverse en fin...
Chemin = "C:\Documents and Settings\Pat\My Documents\Remax\fiches client\Alain Pierre\Prospects\"
Mais voilà un classeur qui te permet d'éviter cette erreur et de copier plusieur dossier l'un après l'autre
Faudra bien sur réadapter les cellules à lires.
https://www.cjoint.com/?eekCld5p5C
Il serait préférable de créer une macros à part pour la mise en forme de ton classeur "En Vigueur" et de pas tout mélanger.
Tu dis...

Réponse 8 / 9

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
2 avril 2009 à 10:38

Mais attention, faut adapter les cellules à copier et à sauver pour ne pas fausser tes classeurs.

           For i = 1 To 5
                FL1.Cells(Lig, 3 + i) = FL2.Cells(5, i)
            Next i

Et il n'est pas nécessaire de tout reformater à chaque fois.
Fait d'abord la mise en forme du classeur et tu le sauve, il reviendra comme ça chaque fois que tu l'ouvre.

Réponse 9 / 9

lermite222 Messages postés 8702 Date d'inscription dimanche 8 avril 2007 Statut Contributeur Dernière intervention 22 janvier 2020 1 190
2 avril 2009 à 10:57

J'ai adapter le classeur aux cellules que tu renseigne plus haut..
https://www.cjoint.com/?eek50hhjbS
A+

Saratum
2 avril 2009 à 20:06

Salut,

J'ai adapter ce que tu m'avais donner, et ça donne pas mal ce que je voulais... :)
Mille merci! :) C'est un peu long comme processus vu que j'ai près de 200 fichiers dans les trois répertoire, mais en final, ça donne presque ce que je voulais... me reste juste à travailler sur la mise en forme....

Vraiment, Merci, t un chef :)

Sub LireRepertoir()
' Touche de raccourci du clavier: Ctrl+k

' Rend le processus invisible
    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

'Formatage de feuille
    Sheets("En Vigueur").Select
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Propriétés"
    Columns("A:A").ColumnWidth = 72
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Prix demandé"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "PRIX à MRN Choisi"
    Columns("B:C").Select
    Selection.ColumnWidth = 17
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Numéro PA"
    Columns("D:D").ColumnWidth = 13
    Rows("1:1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Columns("E:E").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Sheets("En Vigueur").Select
    Cells.Select
    Selection.Copy
    Sheets("Expirés").Select
    Cells.Select
    ActiveSheet.Paste
    Sheets("PA Faites").Select
    Cells.Select
    ActiveSheet.Paste
    Sheets("En Vigueur").Select
    Application.CutCopyMode = False
    
'lire le répertoir et mettre les noms classeur dans la feuille En Vigueur
Dim fs, F, f1, S, sf
Dim Ext As String, Chemin As String
Dim T As String, Lig As Long, i As Integer
Dim FL1 As Worksheet
Dim FL2 As Worksheet
Dim Hyper As String

    Ext = "xlsm" 'type de fichier à lire
    Chemin = "C:\Documents and Settings\Pat\My Documents\Remax\fiches client\Alain Pierre\Prospects\" 'répertoir où sont situés les fichiers.
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    Set FL1 = Sheets("En Vigueur")
    Lig = 4
    For Each f1 In sf
        'tester l'extention
        If f1.Name <> ThisWorkbook.Name And Right(f1.Name, Len(Ext)) = Ext Then
            'Inscrire le chemin et le nom du classeur
            FL1.Cells(Lig, 5) = Chemin
            FL1.Cells(Lig, 1) = f1.Name
            Hyper = Cells(Lig, 5) & Cells(Lig, 1)
            Cells(Lig, 1).Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Hyper
            'ouvrir le classeur
            Workbooks.Open Chemin & f1.Name
            'sheet 1
            Set FL2 = ActiveWorkbook.Sheets(2)
                FL1.Cells(Lig, 2) = FL2.Cells(32, 11)
            Set FL2 = ActiveWorkbook.Sheets(6)
                FL1.Cells(Lig, 3) = FL2.Cells(45, 5)
            Set FL2 = ActiveWorkbook.Sheets(7)
                FL1.Cells(Lig, 4) = FL2.Cells(1, 192)
            Workbooks(f1.Name).Close SaveChanges:=False
            Set FL2 = Nothing
            Lig = Lig + 1
        End If
    Next
    
    Chemin = "C:\Documents and Settings\Pat\My Documents\Remax\fiches client\Alain Pierre\Prospects\Expirés\" 'répertoir où sont situés les fichiers.
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    Set FL1 = Sheets("Expirés")
    Lig = 4
    For Each f1 In sf
        'tester l'extention
        If f1.Name <> ThisWorkbook.Name And Right(f1.Name, Len(Ext)) = Ext Then
            'Inscrire le chemin et le nom du classeur
            FL1.Cells(Lig, 5) = Chemin
            FL1.Cells(Lig, 1) = f1.Name
            Hyper = Cells(Lig, 5) & Cells(Lig, 1)
            Cells(Lig, 1).Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Hyper
            'ouvrir le classeur
            Workbooks.Open Chemin & f1.Name
            'sheet 1
            Set FL2 = ActiveWorkbook.Sheets(2)
                FL1.Cells(Lig, 2) = FL2.Cells(32, 11)
            Set FL2 = ActiveWorkbook.Sheets(6)
                FL1.Cells(Lig, 3) = FL2.Cells(45, 5)
            Set FL2 = ActiveWorkbook.Sheets(7)
                FL1.Cells(Lig, 4) = FL2.Cells(1, 192)
            Workbooks(f1.Name).Close SaveChanges:=False
            Set FL2 = Nothing
            Lig = Lig + 1
        End If
    Next
    
    Chemin = "C:\Documents and Settings\Pat\My Documents\Remax\fiches client\Alain Pierre\PA Faite\" 'répertoir où sont situés les fichiers.
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set F = fs.GetFolder(Chemin)
    Set sf = F.Files
    Set FL1 = Sheets("PA Faites")
    Lig = 4
    For Each f1 In sf
        'tester l'extention
        If f1.Name <> ThisWorkbook.Name And Right(f1.Name, Len(Ext)) = Ext Then
            'Inscrire le chemin et le nom du classeur
            FL1.Cells(Lig, 5) = Chemin
            FL1.Cells(Lig, 1) = f1.Name
            Hyper = Cells(Lig, 5) & Cells(Lig, 1)
            Cells(Lig, 1).Select
            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Hyper
            'ouvrir le classeur
            Workbooks.Open Chemin & f1.Name
            'sheet 1
            Set FL2 = ActiveWorkbook.Sheets(2)
                FL1.Cells(Lig, 2) = FL2.Cells(32, 11)
            Set FL2 = ActiveWorkbook.Sheets(6)
                FL1.Cells(Lig, 3) = FL2.Cells(45, 5)
            Set FL2 = ActiveWorkbook.Sheets(7)
                FL1.Cells(Lig, 4) = FL2.Cells(1, 192)
            Workbooks(f1.Name).Close SaveChanges:=False
            Set FL2 = Nothing
            Lig = Lig + 1
        End If
    Next
    
    With Application
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

Discussions similaires

Symbole Attention dans Word

Fichier word verrouillé

Discussions similaires

Newsletters