ghostjc
Messages postés4Date d'inscriptionmercredi 27 septembre 2006StatutMembreDernière intervention21 avril 2007
-
18 avril 2007 à 05:02
cs_MPi
Messages postés3877Date d'inscriptionmardi 19 mars 2002StatutMembreDernière intervention17 août 2018
-
26 avril 2007 à 03:15
je l'ai modifier un peu mais il m'affiche en a1 le chemin complet du repertoire.
en a2 jusque fin des images qui ce trouve dans le repertoire .
je m'explique :
c:/2001/montagne/il y a 5 photos
/mere/il y a 6 photos
/campigue/ il y a 5 photos
jusqu'au moment ou il n'y a plus de repertoire en 2001
Sub lien_hypertext_liste_fichiers()
'
' lien_hypertext_liste_fichiers Macro
' Macro enregistrée le 13/01/2007 par didus
'
Dim mess As String, mess2 As String, répertoire As String
Columns(1).Clear
Columns(2).Clear
mess = InputBox("Chemin complet du répertoire à explorer, attention, / à la fin", "Chemin du répertoire", _
"D:\__test\389_ar_std\")
mess2 = InputBox( _
"Donnez seulement le type de fichier (par exemple pdf, xls, doc, jpg ou dxf etc...)" _
, "TYPE DE FICHIER", "jpg")
Application.ScreenUpdating = False
répertoire = Dir(mess & "*" & mess2, vbDirectory)
Do While répertoire <> ""
i = i + 1
Cells(1, i) = répertoire
ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, i), Address:=mess & répertoire
'Cells(i, 2) = mess & répertoire
répertoire = Dir
Loop
End Sub
ghostjc
Messages postés4Date d'inscriptionmercredi 27 septembre 2006StatutMembreDernière intervention21 avril 2007 18 avril 2007 à 21:18
bonjour a tous
bon je vois que vous n'avé pas compris.
l'esser tomber le petit programme.
imaginer que vous aver un repertoire albomme photo,dans ce repertoire il y a 3 autres repertoire bon il peu y en avoir plus.
les 3 autres repertoire son 2001 , 2002 ,2003
dans s'est repertoire il y a a chaque fois ± 5 photos en jpg.
ce que j'aurer bien voulus avoir s'est un programme qui m'affiche dans un fichier excel
qu'il me demande quel repertoire il dois ouvrir puis qu'il m'affiche dans un tableau horizotale 2001 et le 5 photos qu'il y a dans le repertoire.
en a2 toujours horizotale 2002 et le 5 photos.et insi de suite et le programme s'arrette quand il n'y a plus de repertoire.
je vais joindre un fichier que j'ai eu mais lui affiche verticalement au lieus d'horitalement.
'Les déclarations et la fonction getdirectory qui suivent
'permettent d'ouvrir une boite de dialogue de type "choix d'un dossier"
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function
Sub Repertorier()
'Une méthode basique sans API pour lister les répertoires et
'sous-répertoires. Michel Pierron, MPFE 2002. Adaptation Flo Cabon sur une idée de "mrik"
'* nRow = Ligne de départ
'* FolderName = Chemin du répertoire à lister
'* Suffix = Filtre optionnel des types de fichiers
'* SubDir = True pour étendre la liste aux sous-répertoires
Dim LeMessage As String, LeRepertoire As String, Lextension As String
Dim Profondeur As VbMsgBoxResult
Dim nRow As Long
LeMessage = "Choisissez le dossier à analyser"
LeRepertoire = GetDirectory(LeMessage)
Lextension = InputBox("indiquez éventuellement une extension de fichier pour filtrer les fichiers", "Type de fichier", "*.*")
Profondeur = MsgBox("Voulez vous analyser aussi les sous-répertoires ?", vbYesNo, "Profondeur d'analyse")
nRow = InputBox("indiquez le N° de la première ligne pour le tableau de sortie", "Sortie des résultats", "1")
If Profondeur = vbYes Then
truc = Lister(nRow, LeRepertoire, Lextension, True)
Else
truc = Lister(nRow, LeRepertoire, Lextension, False)
End If
End Sub
Function Lister(nRow&, FolderName$, Optional Suffix$ "*.*", Optional SubDir As Boolean True)
Dim i As Long, x As Long, File As String, Folder As String, nbFolders() As String
Cells(nRow, 1) = FolderName
Cells(nRow, 1).Font.Bold = True If Not Right(FolderName, 1) "" Then FolderName FolderName & ""
File = Dir(FolderName & Suffix)
Do While Len(File) > 0
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(nRow, 2), _
Address:=FolderName & File, _
TextToDisplay:=File
End With
nRow = nRow + 1
File = Dir
Loop
If Not SubDir Then Exit Function
x = 0
Folder = Dir(FolderName, vbDirectory)
Do While Folder > ""
If Folder <> "." And Folder <> ".." Then If (GetAttr(FolderName & Folder) And vbDirectory) vbDirectory Then x x + 1
End If
Folder = Dir
Loop
ReDim nbFolders(x + 1)
i = 1
nbFolders(i) = Dir(FolderName, vbDirectory)
Do While nbFolders(i) > ""
If nbFolders(i) <> "." And nbFolders(i) <> ".." Then If (GetAttr(FolderName & nbFolders(i)) And vbDirectory) vbDirectory Then i i + 1
End If
nbFolders(i) = Dir
Loop
For i = 1 To UBound(nbFolders()) - 1
Call Lister(nRow, FolderName & nbFolders(i), Suffix)
Next
End Function
bon je n'arrive pas a joindre le fichier soit complet soit en zip
ghostjc
Messages postés4Date d'inscriptionmercredi 27 septembre 2006StatutMembreDernière intervention21 avril 2007 21 avril 2007 à 08:47
bonjour a tous
bon je pensse qu'on ma oublier,ou mon explication n'est peu aire pas asser clair ?.
imaginer que vous aver un repertoire albomme photo,dans ce repertoire il y a 3 autres repertoire bon il peu y en avoir plus.
les 3 autres repertoire son 2001 , 2002 ,2003
dans s'est repertoire il y a a chaque fois ± 5 photos en jpg.
ce que j'aurer bien voulus avoir s'est un programme qui m'affiche dans un fichier excel
qu'il me demande quel repertoire il dois ouvrir puis qu'il m'affiche dans un tableau horizotale 2001 et le 5 photos qu'il y a dans le repertoire.
en a2 toujours horizotale 2002 et le 5 photos.et insi de suite et le programme s'arrette quand il n'y a plus de repertoire.
je vais joindre un fichier que j'ai eu mais lui affiche verticalement au lieus d'horitalement.
'Les déclarations et la fonction getdirectory qui suivent
'permettent d'ouvrir une boite de dialogue de type "choix d'un dossier"
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
Dim Dossier As String
bInfo.pidlRoot = 0&
If IsMissing(Msg) Then
bInfo.lpszTitle = "Choisissez un dossier de destination pour les sauvegardes."
Else
bInfo.lpszTitle = Msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory & ""
Else
GetDirectory = ""
End If
End Function
Sub Repertorier()
'Une méthode basique sans API pour lister les répertoires et
'sous-répertoires. Michel Pierron, MPFE 2002. Adaptation Flo Cabon sur une idée de "mrik"
'* nRow = Ligne de départ
'* FolderName = Chemin du répertoire à lister
'* Suffix = Filtre optionnel des types de fichiers
'* SubDir = True pour étendre la liste aux sous-répertoires
Dim LeMessage As String, LeRepertoire As String, Lextension As String
Dim Profondeur As VbMsgBoxResult
Dim nRow As Long
LeMessage = "Choisissez le dossier à analyser"
LeRepertoire = GetDirectory(LeMessage)
Lextension = InputBox("indiquez éventuellement une extension de fichier pour filtrer les fichiers", "Type de fichier", "*.*")
Profondeur = MsgBox("Voulez vous analyser aussi les sous-répertoires ?", vbYesNo, "Profondeur d'analyse")
nRow = InputBox("indiquez le N° de la première ligne pour le tableau de sortie", "Sortie des résultats", "1")
If Profondeur = vbYes Then
truc = Lister(nRow, LeRepertoire, Lextension, True)
Else
truc = Lister(nRow, LeRepertoire, Lextension, False)
End If
End Sub
Function Lister(nRow&, FolderName$, Optional Suffix$ "*.*", Optional SubDir As Boolean True)
Dim i As Long, x As Long, File As String, Folder As String, nbFolders() As String
Cells(nRow, 1) = FolderName
Cells(nRow, 1).Font.Bold = True If Not Right(FolderName, 1) "" Then FolderName FolderName & ""
File = Dir(FolderName & Suffix)
Do While Len(File) > 0
With ActiveSheet
.Hyperlinks.Add Anchor:=.Cells(nRow, 2), _
Address:=FolderName & File, _
TextToDisplay:=File
End With
nRow = nRow + 1
File = Dir
Loop
If Not SubDir Then Exit Function
x = 0
Folder = Dir(FolderName, vbDirectory)
Do While Folder > ""
If Folder <> "." And Folder <> ".." Then If (GetAttr(FolderName & Folder) And vbDirectory) vbDirectory Then x x + 1
End If
Folder = Dir
Loop
ReDim nbFolders(x + 1)
i = 1
nbFolders(i) = Dir(FolderName, vbDirectory)
Do While nbFolders(i) > ""
If nbFolders(i) <> "." And nbFolders(i) <> ".." Then If (GetAttr(FolderName & nbFolders(i)) And vbDirectory) vbDirectory Then i i + 1
End If
nbFolders(i) = Dir
Loop
For i = 1 To UBound(nbFolders()) - 1
Call Lister(nRow, FolderName & nbFolders(i), Suffix)
Next
End Function
bon je n'arrive pas a joindre le fichier soit complet soit en zip
cs_MPi
Messages postés3877Date d'inscriptionmardi 19 mars 2002StatutMembreDernière intervention17 août 201823 26 avril 2007 à 03:15
Je pense que tu devrais reposer ta question tout en étant assez précis sur le point qui cause problème...
Ici, je pense que tu cherches à faire une Fonction récursive pour lire les répertoires et les sous-répertoires d'un répertoire donné... Est-ce bien ça ?