|
|
|
|
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
Configuration: Windows XP Firefox 3.0.6
Bonjour,
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+ L'expérience instruit plus sûrement que le conseil. (André Gide) Si tu te cogne à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius) |
Merci Lermite222
|
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....
|
J'ai une erreur d'exécution 1004 à l'ouverture du fichier... probablement a cause de la longueur du nom de mes fichier....
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 |
Non,
|
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. L'expérience instruit plus sûrement que le conseil. (André Gide) Si tu te cogne à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius) |
J'ai adapter le classeur aux cellules que tu renseigne plus haut..
|
Ajouter une police dans word Cacher liste amis facebook Convertir word en pdf Java lister repertoire List to do freeware Liste déroulante excel 2007 Liste pokemon diamant Lister repertoire Lister repertoire html Lister repertoire php Lister répertoire dos Note de bas de page word 2007 Php lister repertoire sous repertoire Script lister repertoire Tomcat lister contenu répertoire Télécharger word Word 2007 gratuit Zone de liste déroulante word
