Dresser liste d'un répertoire dans word Résolu/Fermé

Question

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

Raymond PENTIER · Answer

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.

lermite222 · Answer

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+

saratum · Answer

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..

lermite222 · Answer

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

saratum · Answer

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?

saratum · Answer

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

lermite222 · Answer

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...

lermite222 · Answer

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.

lermite222 · Answer

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