La Guilde Des Troubadours
Vous souhaitez réagir à ce message ? Créez un compte en quelques clics ou connectez-vous pour continuer.


Amis musiciens, soyez les bienvenues sur le forum de La Guilde Des Troubadours. Notre confrérie Lotro, sur Sirannon, s'est constituée dans le seul but de jouer de la musique ensemble et de donner des concerts dans divers lieux de la Terre du Millieu.
 
AccueilDernières imagesS'enregistrerConnexion
Le Deal du moment : -20%
-20% sur le Lot de 2 écrans PC GIGABYTE ...
Voir le deal
429 €

 

 Boite à outils Excel

Aller en bas 
AuteurMessage
Ulchireth

Ulchireth



Boite à outils Excel Empty
MessageSujet: Boite à outils Excel   Boite à outils Excel EmptySam 17 Sep - 19:49

Salut tout le monde,

Etant d'un naturel fainéant et pour me simplifier la vie voila un petit bout de code VBA Excel afin d'avoir rapidement le listing des fichiers d'un répertoire et ses sous répertoires dans une feuille Excel

Option Explicit
Public Chemin As String, I As Long
Sub RepFichiers()
Dim objShell As Object, objFolder As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
On Error GoTo 0
If Chemin = "" Then Exit Sub
Application.ScreenUpdating = False
With ActiveSheet
.Range("B12") = Chemin
.Range("B16:E10000").ClearContents
End With
I = 16
ListeFichier (Chemin)
End Sub
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
With ActiveSheet
For Each SousDossier In Dossier.SubFolders
.Cells(I, 2) = SousDossier.Name
For Each Fichier In SousDossier.Files
.Cells(I, 3) = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1) 'Nom du fichier avec l'extension
.Cells(I, 4) = Dossier & "\" & SousDossier & "\" & Fichier.Name

.Cells(I, 5) = Fichier.DateCreated ' Date de création
.Cells(I, 6) = Fichier.DateLastModified ' dernière modification
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I, 4), Address:=SousDossier & "\" & Fichier.Name
I = I + 1
Next
Next
End With
End Function


pour rappel pour ouvrir l'interface de programmation d'excel Appuyer sur ALT F11
Puis sur le menu insertion - module
et copier le texte ci-dessus

Fermer l’éditeur VBA
puis dans excel lancer la macro ListerFichier
dans le feuille active vous obtiendrez le listing des noms de fichier du répertoire sélectionné au départ ainsi que de ses sous répertoires
en prime un lien html vers le fichier en question

(Zed je pense que ce genre de bricole va t'aider dans le listing des morceaux après tu devrais t'en sortir pour ce qui est de récupérer l'auteur l’interprète et le morceau)
Revenir en haut Aller en bas
 
Boite à outils Excel
Revenir en haut 
Page 1 sur 1

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
La Guilde Des Troubadours :: La Cave :: Hors de propos-
Sauter vers: