Bonjour,
est ce que vous pouvez m'aider à comprendre ou est mon erreur?
merci beaucoup
 
 
 
'
' test Macro
'
 
 
'Option Explicit
Dim NbFichiers As Integer
 
'   Dossier des classeurs à traiter
Const Dossier As String = "C:\Documents and Settings\mkhalmadani\Bureau\Dossier"
'   On suppose que tous les fichiers contiennent les données dans Feuil1
'       Si un onglet ne s'appelle pas NomFeuille
'       une erreur #REF! est inscrite dans les cellules concernées
Const NomFeuille As String = "General"
   
Private Sub Entete()
    With ShImport
        ' Tout effacer
        Cells.Clear
        Range("A3" ).Formula = "Fichier"
        ' A tout hasard cela peut être interessant
        ' d'avoir ces infos sur les fichiers
        Range("B3" ) = "Date de Création"
        Range("C3" ) = "Date Dernière Modification"
   
        'test avec quelques cellules
         
        Range("D3" ) = "toto"
        Range("E3" ) = "titi"
        Range("F3" ) = "toto"
        Range("G3" ) = "titi"
        Range("H3" ) = "Dtiti"
        Range("I3" ) = "doto"
    End With
End Sub
   
Private Sub ListeFichiersDans(NomDossierSource As String)
Dim FSO As Scripting.FileSystemObject
Dim DossierSource As Scripting.Folder
Dim Fichier As Scripting.file
Dim r As Long
   
    Set FSO = New Scripting.FileSystemObject
    Set DossierSource = FSO.GetFolder(NomDossierSource)
       
    NbFichiers = 0
  r = ShImport.Range("A63536" ).End(xlUp).Row + 1
       
    ' Balayer le dossier et extraire le nom des fichiers
    For Each Fichier In DossierSource.Files
        With ShImport
           Cells(r, 1) = Fichier.Name
           Cells(r, 2) = Fichier.DateCreated
           Cells(r, 3) = Fichier.DateLastModified
        End With
        NbFichiers = NbFichiers + 1
        r = r + 1
    Next Fichier
       
    Set Fichier = Nothing
    Set DossierSource = Nothing
    Set FSO = Nothing
End Sub
   
'   Permet de lire une valeur dans un fichier Excel fermé
Private Function ExtraireValeur(ByVal Dossier As String, ByVal Fichier As String, ByVal Feuille As String, ByVal Cellule As String)
Dim Argument As String
    Fichier = Replace(Fichier, "'", "''" )
    Argument = "'" & Dossier & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Address(, , xlR1C1)
    ExtraireValeur = ExecuteExcel4Macro(Argument)
End Function
 
Private Sub DispoBoutons()
Dim t As Range
    With ShImport
        .Activate
        .Rows(1).RowHeight = 12.75
        .Rows(2).RowHeight = 12.75
           
        Set t = .Cells(1, 3)
        With .Buttons("btnImport" )
            .Left = t.Left + 3
            .Top = t.Top + 5
            .Width = t.Width - 6
            .Height = Rows(1).RowHeight + Rows(2).RowHeight - 8
        End With
    End With
End Sub
   
Private Sub Workbook_Open()
    DispoBoutons
    With ActiveWindow
        .ScrollRow = 1
        .ScrollColumn = 1
    End With
    ShImport.Range("A1" ).Select
End Sub
 
 
 
Sub btnImport_QuandClic()
Dim Debut As Variant
Dim NumeroLigne As Integer, i As Integer
Dim NomFichier As String
Dim DDate As String
Dim DossierOk As String
   
    ' Par curiosité
    Debut = Time()
    Application.ScreenUpdating = False
        Entete
        DossierOk = Dossier
        ' Pour éviter le drame du copier/coller ....
        If Right(DossierOk, 1) <> "\" Then DossierOk = DossierOk & "\"
   
        ListeFichiersDans DossierOk
           
        ' Si un onglet de NomFichier ne s'appelle pas NomFeuille
        ' une erreur #REF! est incrite dans les cellules concernées
           
        ' On démarre à cette ligne
        NumeroLigne = 4
        For i = 1 To NbFichiers
            NomFichier = ShImport.Range("A" & NumeroLigne)
   
            With ShImport
                Cells(NumeroLigne, 4) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "A7" )
                Cells(NumeroLigne, 5) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "D7" )
                Cells(NumeroLigne, 6) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "H7" )
                Cells(NumeroLigne, 7) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "J7" )
                Cells(NumeroLigne, 8) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "D7" )
                Cells(NumeroLigne, 9) = ExtraireValeur(DossierOk, NomFichier, NomFeuille, "H7" )
   
     
            End With
               
            NumeroLigne = NumeroLigne + 1
            Application.StatusBar = i & " / " & NbFichiers
        Next
           
        Application.StatusBar = "Terminé : " & Format((Time() - Debut) * 100000, "0.00" )
       
        ' Revenir en haut à gauche
        With ActiveWindow
            ScrollRow = 1
            ScrollColumn = 1
        End With
           
       With ShImport
           Rows("3:3" ).Font.Bold = True
           Columns("B:C" ).Select
           With Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
           End With
           Columns("A:I" ).Columns.AutoFit
           Range("A1" ).Select
      End With
    Application.ScreenUpdating = True
End Sub
 
 
 
 
 
 

C'est plutot a toi de nous dire sur quelle ligne le code s'arrete...