Macro affichage "durée" fichier

' Ajouter une référence à "abcAVI Info Library"
' (barre des menus/Outils/Références...)
Option Explicit
Public Sub Listing_Affiche_la_Durée()
' Liste la durée des films
'
Const chemin$ = "F:\Films\Action"          'Adapter le répertoire
Const nbmax% = 5000                        'Adapter nbre max de films
Dim tag As New abcAVI.ExtendedAVITags
Dim AviInfos As Variant
Dim lgr(1 To nbmax) As Variant
Dim fichier As String
Dim manque As String
Dim début As Single
Dim temps As Single
Dim ctr As Integer
Dim cte As Integer

  début = Timer
  Application.EnableEvents = False
  Range("C1:C" & nbmax).ClearContents
  Range("E1:C" & nbmax).ClearContents
  Application.ScreenUpdating = False
  fichier = Dir(chemin & "\*.avi")
  ctr = 1
  Do While Len(fichier) > 0
    Cells(ctr, 3).Value = fichier
    tag.ReadAVITags chemin & "\" & fichier, PM_Lite_Mode + _
                    PM_Tech_Info, 0, AviInfos
    lgr(ctr) = tag.GetInfo(AviInfos, IDI_Video_Stream, IDV_Duration)
    If IsNumeric(lgr(ctr)) Then
      lgr(ctr) = Val(lgr(ctr)) / (24# * 3600# * 1000#)
    Else
      lgr(ctr) = ""
      cte = cte + 1
      manque = manque & cte & ") Film n° " & ctr & vbCrLf
    End If
    ctr = ctr + 1
    fichier = Dir
  Loop
  Range("C1").Resize(ctr).Value = Application.Transpose(lgr)
  Range("C1").Resize(ctr).NumberFormat = "hh:mm:ss"
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  
  temps = Timer - début
  If manque > "" Then
    manque = "Manque durée de : " & vbCrLf & manque & vbCrLf
    Range("E1").Resize(cte + 1).Value = _
       Application.Transpose(Split(manque, vbCrLf))
  End If
  MsgBox "Terminé en " & Int(temps / 60) & " min. " & _
         Int(temps Mod 60) & " sec. " & _
         Int(temps * 1000 Mod 1000) & " milièmes"
End Sub