Liste automatique

stella-30 Messages postés 148 Statut Membre -  
cs_Le Pivert Messages postés 8437 Statut Contributeur -
Bonjour, ma demande est particulière :
Je dispose d'un disque dur de 2TO de mémoire, et ce dernier est plein de vidéo toutes nommées.
J'aurai aimé savoir s'il existe un moyen de créer un fichier excel qui m'indique la liste complète de toutes mes vidéos ?
Peut-être un logiciel, je ne sais pas ...
Merci d'avance.
Stella

7 réponses

  1.
    Cesel45 Messages postés 13762 Date d'inscription   Statut Contributeur Dernière intervention   2 845
     
    Bonjour

    En faites tu veux copier ta liste que tu as dans l'explorateur Windows
    et le coller dans un fichier Excel..?
    Le problème c'est que ta liste n'est pas formater
    Titre / Durée / ..etc

    Si tu as une 30ène de film...à part le taper à la main...non je ne vois pas...!!!!!
    0
  2. stella-30 Messages postés 148 Statut Membre 56
     
    C'est bien ce que je craignais.
    Merci de ta réponse.
    0
    1. Cesel45 Messages postés 13762 Date d'inscription   Statut Contributeur Dernière intervention   2 845
       
      Mais tu veux de l'aide pour qu'on te le fasse.....

      N'hésite pas de laisser ta liste ici....(en pièce joint)
      http://pjjoint.malekal.com/

      Un membre sympatique te fera un ficher Excel.
      0
  3. Raymond PENTIER Messages postés 58209 Date d'inscription   Statut Contributeur Dernière intervention   17 480
     
    Tout d'abord, quel est l'intérêt de mettre cette liste sur Excel ?
    Qu'espères-tu pouvoir faire avec une telle liste ?
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Bonjour ,

    Lister sur une feuille Excel tout un repertoire en vba:

    Ouvrir un classeur, Faire Alt F11, insérer un module (insertion) et mettre ce code: 

    Option Explicit
'RECUPERATION REPERTOIRES ET NOMS DE FICHIERS DANS UN CLASSEUR
' (Exécuter la macro AfficheFichiers())
Sub AfficheFichiers()
Dim LeChemin As String
Dim Lextension As String
Dim LeTitre As String
Dim Arret As Boolean

  LeTitre = "Répertoires et sous-répertoires"
  Arret = False
  Application.ScreenUpdating = True
   Range("A1").Activate
  Do
    LeChemin = ChoisirDossier
    If Len(LeChemin) = 0 Then
      Arret = True
    Else
      If Mid(LeChemin, Len(LeChemin), 1) <> "" Then
        LeChemin = LeChemin + ""
      End If
      If Len(Dir(LeChemin, vbDirectory)) <> 0 Then
        Lextension = "*.*"
        Call Remplir(LeChemin, Lextension)
        Arret = True
      Else
       MsgBox "Répertoire introuvable...Recommencer ?"
      End If
    End If
  Loop Until Arret
  End Sub
Private Sub Remplir(RepertParent, ExtFichier)
' Remplit la feuille courante avec le contenu du répertoire RepertParent
' Les noms de répertoires sont placés dans la colonne active à partir de
' la cellule active
' Les noms de fichiers correspondants à ExtFichier sont affichés dans la
' colonne de droite
' 14/02/2000 18:30, Gérard B, mpfe

Dim Compteur As Integer
Dim NbreRepert As Integer
Dim LeFichier As String
Dim LeDossier As String
Dim ExtLocale As String
Dim ParentLocal As String
Dim LeDossierLocal() As String
Dim ext As String
    ExtLocale = ExtFichier
    LeFichier = Dir(RepertParent & ExtFichier)
    If Len(LeFichier) = 0 Then
        ActiveCell.Value = RepertParent
        ActiveCell.Offset(1, 1).Select
    End If
    Do While Len(LeFichier) <> 0
       ' ActiveCell.Value = (RepertParent & LeFichier)
       ' ActiveCell.Offset(1, 0).Select
       ext = Right(LeFichier, 4) ' renvoie ".ext"
       LeFichier = Replace(LeFichier, ext, "") 'supprime l'extension
       ActiveCell.Value = LeFichier
        ActiveCell.Offset(1, 0).Select
        LeFichier = Dir
    Loop
    'Compter le nombre de sous-répertoires
    NbreRepert = 0
    LeDossier = Dir(RepertParent, vbDirectory)
    Do While LeDossier <> ""
        If LeDossier <> "." And LeDossier <> ".." Then
            If (GetAttr(RepertParent & LeDossier) _
                    And vbDirectory) = vbDirectory Then
                NbreRepert = NbreRepert + 1
            End If
        End If
        LeDossier = Dir
    Loop
    ReDim LeDossierLocal(NbreRepert + 1)
    Compteur = 1
    LeDossierLocal(Compteur) = Dir(RepertParent, vbDirectory)
    Do While LeDossierLocal(Compteur) <> ""
        If LeDossierLocal(Compteur) <> "." _
                    And LeDossierLocal(Compteur) <> ".." Then
            If (GetAttr(RepertParent & LeDossierLocal(Compteur)) _
                        And vbDirectory) = vbDirectory Then
                Compteur = Compteur + 1
            End If
        End If
        LeDossierLocal(Compteur) = Dir
    Loop
    For Compteur = 1 To UBound(LeDossierLocal()) - 1
        ParentLocal = RepertParent & LeDossierLocal(Compteur) & ""
        Call Remplir(ParentLocal, ExtLocale)
    Next
End Sub

Function ChoisirDossier()
    Dim objShell, objFolder, chemin As String, SecuriteSlash
                                            
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisisser un répertoire", &H1&)
    On Error Resume Next
    chemin = objFolder.Items.Item.Path

    SecuriteSlash = InStr(objFolder.Title, ":")

    If SecuriteSlash > 0 Then
        chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
    End If
    ChoisirDossier = chemin
End Function


    Ensuite inserer un UserForm (insertion), y mettre un commandbutton, double cliquer sur ce commandbutton et y mettre ce code: 

    AfficheFichiers


    Compiler en faisant F5

    Voilà vous aurez votre liste!
    0
  7. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Voici un classeur qui vous permet de lister un répertoire avec toutes les données. Vous pouvez ouvrir également les fichiers depuis ce classeur.

    Cliquez ici pour le télécharger:

    http://cjoint.com/data3/3JkldDhX3lz.htm
    0
  8. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    J'ai oublié de nettoyer la feuille pour une nouvelle recherche.
    Mettre ceci dans le module à cet emplacement: 

      ' create a new workbook for the file list
 ' Workbooks.Add
  ActiveSheet.Cells.Clear

    0