|
Voici une méthode qui permet de lister les fichiers txt depuis Excel et de l'afficher sur une nouvelle feuille par un simple double clic sur le nom
'************************************
'partie à coller dans un module feuille
'************************************
Option Explicit
'ici c'est un bouton sur la feuille
'qui lance la procédure d'ouverture
'de la boite de dialogue
Private Sub CommandButton1_Click()
ListerFichier
End Sub
'l'action du double clic sur le nom du fichier
'affiche son contenu sur une nouvelle feuille
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Ti
With Target
If .Column > 1 Or .Value = "" Then Exit Sub
OuvrirTXT .Value
End With
Cancel = True
End Sub
'
'************************************
'partie à coller dans un module
'************************************
'
'Ti xlti@wanadoo.fr
'
Option Explicit
Private Function GetFExt(PFichier As String) As String
'Ti
GetFExt = Mid(PFichier, InStrRev(PFichier, ".") + 1)
End Function
Sub OuvrirTXT(PFichier As String)
'Ti
Dim Chemin As String
Dim RetVal
With ActiveSheet
Chemin = .[A2] & "\"
End With
If LCase(GetFExt(PFichier)) = "txt" Then
Workbooks.OpenText Chemin & PFichier
End If
End Sub
Private Sub NouveauChemin(Pchemin As String, PExt As String)
'Ti
Dim LChemin
LChemin = Application _
.GetOpenFilename(("Fichiers texte (*.txt), *.txt,Fichiers texte (*.txt), *.txt"), Title:="Parcourir...")
If LChemin <> False Then
Pchemin = Left(LChemin, InStrRev(LChemin, Application.PathSeparator) - 1)
PExt = GetFExt(CStr(LChemin))
End If
End Sub
Sub ListerFichier()
' Vériland
' septembre 03
' lister des fichiers texte
' pour Excel downloads
' http://www.excel-downloads.com/html/French/forum/messages/1_50255_50255.htm
'
Dim Chemin As String, Extens As String
Dim Cel As Range, Trouve As Long
NouveauChemin Chemin, Extens
If Chemin = "" Then Exit Sub
With ActiveSheet
.UsedRange.Delete
Set Cel = .[A1]
End With
With Cel
.Value = "Chemin fichier"
.Offset(0, 1) = "Taille"
.Offset(0, 2) = "Date/Heure"
With .Resize(1, 3)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.Offset(1, 0) = Chemin
End With
Set Cel = Cel.Offset(2, 0)
With Application.FileSearch
.NewSearch
.LookIn = Chemin
.Filename = "*." & Extens
.SearchSubFolders = False
.Execute msoSortByFileName
For Trouve = 1 To .FoundFiles.Count
Cel.Value = Mid(.FoundFiles(Trouve), InStrRev(.FoundFiles(Trouve), "\") + 1)
Cel.Offset(0, 1) = FileLen(.FoundFiles(Trouve))
Cel.Offset(0, 2) = FileDateTime(.FoundFiles(Trouve))
Set Cel = Cel.Offset(1, 0)
Next Trouve
End With
ActiveSheet.UsedRange.EntireColumn.AutoFit
End Sub
Date de création : 24/05/2005 - 18:58
Dernière modification : 25/05/2005 - 22:59
Catégorie : Feuille
Page lue 335 fois
 Prévisualiser la page
 Imprimer la page
|
|
OOo
OOo
Membres: 1661
Membre en ligne: 0
Anonymes en ligne: 34
Haut 
