Salut
 
Je cherche à faire quelque chose de simple en soit, mais je sais pas si c'est possible.
 
En fait, il faudrait qu'une formule excel me compte le nombre de fichiers (tous types confondus) dans un répertoire précis.
 
J'ai trouvé une méthode permettant de rappatrier la liste des noms de fichier d'un repertoire via "dir > listefichiers.txt" dans DOS, mais peut être qu'il y a un moyen plus rapide, plus précise ?
 
J'ai quelques bases en VBA, mais c'est limité hein

Up ?

Repris de http://forum.hardware.fr/hfr/Progr [...] 5126_1.htm

Merci !
 
J'ai adapté pour insérer le chiffre dans une cellule.

Bonjour,
J'ai un petit problème avec ce code..
le lancement de la procédure me renvoi un message d'erreur qui est le suivant :
 
******************************
erreur de compilation:
Type défini par l'utilisateur non défini.
******************************
 
Quelle manip dois je faire pour que la macro fonctionne correctement ?
 
Par avance merci..
C'est très important pour moi.
Mathieu

Soir Bon, qu'y a t-il entre

 
Sinon en "Late Binding"

non en fait j'navais pas ouvert la librairie ms scripting runtime
 
mais ca fonctionne avec object
That's ok !
 
Dsl

Bonjour,
 
Serait il possible d'avoir le code adapte?
 

Hello
 
3 ans apres ca risque d'etre chaud...
 
Range("A1" ).Value = r
 

bonjour à tous
 
j'aurai besoin d'aide sur VBA Excel 2007, windows XP
 
j'utilise le code suivant pour récupérer dans un répertoire où il n'y a que des fichiers Excel, des valeurs d'une seule colonne pour les coller dans un fichier de synthèse (pour réduire le message j'ai enlever la partie de copier/coller d'un fichier à l'autre). Mon fichier synthèse permet de récupérer 30 colonnes différentes (1 colonne/fichier donc 30 fichiers). Au départ je n'ai pas 30 fichiers, ils arrivent au fur et à mesure, du coup, mon code m'ouvre plusieurs fois les mêmes fichiers jusqu'à atteindre la limite que je fixe à ma variable a (12 to 157). 157 étant la dernière colonne où je viens coller les données du dernier fichier (soit le 30ième). Du coup, si par exemple, j'ai que 2 fichiers, au bout de la 3ième boucle, mon copier/coller me décalle non pas de a=a+5 mais ajoute 1 en plus.
 
Comment faire pour qu'il s'arrête en fonction du nombre de fichiers dans le dossier qui s'appele fichier xls?? je pensais le faire compter.
 
 
Sub ouvrir_fichiers()  
AffecterVariables2  
Application.ScreenUpdating = False  
Dim fichier As String, chemin As String  
Dim Wb As Workbook  
 
For a = 12 To 157  
chemin = "C:\Documents and Settings\k004418\Bureau\UGV VIPER\Suivi MMT\fichier xls\"  
fichier = Dir(chemin & "*.xls" )  
 
Do While fichier <> ""  
Set Wb = Workbooks.Open(chemin & fichier)  
 
--> c'est à ce moment qu'il fait le copier/coller d'un fichier à l'autre  
 
Windows(fichier).Activate  
'fermer le fichier Excel sans sauvegarder  
Application.CutCopyMode = False  
ActiveWorkbook.Close savechanges:=False  
 
a = a + 5  
Set Wb = Nothing  
fichier = Dir  
Application.ScreenUpdating = True  
Loop  
Next  
End Sub  
 
 
Sub AffecterVariables2()  
LeFichier = ThisWorkbook.Name  
End Sub  
 
 
 
 
Merci pour votre aide

Tu crées un objet "Scripting.FileSystemObject" qui va te permettre de compter le nb de fichier et de récuperer les noms des fichiers, puis tu appliques ta moulinette.

ok merci
 
je vais voir ce que je trouves car je connais pas du tout cette fonction.
 
 
+

Un truc comme ca devrait le faire :

Sub ouvrir_fichiers()
Application.ScreenUpdating = False
 
    'On définit où se trouvent tes fichiers Excel
    Repertoire = "C:\Documents and Settings\k004418\Bureau\UGV VIPER\Suivi MMT\fichier xls\"
    
    'On définit quelle colonne et quel onglet vont nous interresser dans _
    les classeurs à ouvrir pour les copier ensuite
    'La en gros on va copier la colonne A de l'onglet Feuil1 du classeur qu'on vient d'ouvrir
    Col = 1 'Colonne A. A = 1 ;  B = 2 etc.
    Onglet = "Feuil1"
        
    'On met dans une variable le nom du fichier qui va recevoir les "coller"
    'Donc ton fichier final en somme.
    WBO = ActiveWorkbook.Name
    
    'On créé l'objet FileSystem
    Set fso = CreateObject("Scripting.FileSystemObject" )
    'On créé un objet Dossier, qui va etre ton dossier où sont tes fichiers Excel
    Set Dossier = fso.GetFolder(Repertoire)
    
    'Pour chaque fichier dans ce dossier
    For Each Fichiers In Dossier.Files
    'on verifie qu'il contien "xls" dans le nom pour etre sur que c'est un fichier Excel
    'Il faut aussi vérifier, au cas où ton fichier final soit dans le meme dossier, de ne _
    pas tenter de l'ouvrir à nouveau
    'Remplacer si Office>2003
        If (InStr(1, Fichiers.Name, ".xls", 1) > 0) And Fichiers.Name <> WBO Then
        'Si c'est le cas, tu fais ton code à toi :
        Set Wb = Workbooks.Open(Fichiers.Name)
        'On active le fichier qu'on vient d'ouvrir
        Windows(Fichiers.Name).Activate
        
        'On se place sur la bonne feuille, bonne colonne
        Sheets(Onglet).Columns(Col).Select
        'On copie
        Selection.Copy
        'On se remet sur notre fichier final
        Windows(WBO).Activate
        'La faut voir ou tu veux coller apres.
        ActiveSheet.Paste
 
        'On active le fichier qu'on vient d'ouvrir
        Windows(Fichiers.Name).Activate
 
        'on le ferme
        ActiveWorkbook.Close savechanges:=False
     
        Application.ScreenUpdating = True
        End If
    Next
End Function

merci dje69r
 
je vais les modifs qu'il faut
je vais si je trouves, je découvres au fur et à mesure  
 
:-)
 
+

L'excitation t'a fait oublier des mots...!?
 
Parce que je n'ai rien compris à ton post...

au secours
 
sa marche pas !!
 
voilà le code que j'ai crée avec tes conseils
 
 
Sub ouvrir_fichiers2()
Application.ScreenUpdating = False
 Repertoire = "C:\Documents and Settings\k004418\Bureau\UGV VIPER\Suivi MMT\fichier xls\"
 
Sheets("Explication listing MMT DHP M88" ).Select
For a = 12 To 157
   
WBO = ActiveWorkbook.Name
     
    Set fso = CreateObject("Scripting.FileSystemObject" )
    Set Dossier = fso.GetFolder(Repertoire)
     
    For Each Fichiers In Dossier.Files
        If (InStr(1, Fichiers.Name, ".xls", 1) > 0) And Fichiers.Name <> WBO Then
        Set Wb = Workbooks.Open(Fichiers.Name)        Windows(Fichiers.Name).Activate
         
Range("A5" ).Select
Selection.Copy
Windows(WBO).Activate
Cells(31, a).Select
ActiveSheet.Paste
Cells(30, a).Value = Right(Cells(31, a).Value, 8)
Cells(31, a).Value = Cells(30, a).Value
 With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
     
Windows(Fichiers.Name).Activate
Range("A1:L1" ).Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$I$324" ).AutoFilter Field:=1, Criteria1:="='U*", _
        Operator:=xlAnd
    Cells.Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Rows("1:1" ).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    Range("I1" ).Select
    ActiveWorkbook.Worksheets("Feuil1" ).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1" ).Sort.SortFields.Add Key:=Range("I1" ), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1" ).Sort
        .SetRange Range("A1:I324" )
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    Range("D1" ).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows(WBO).Activate
    Cells(32, a).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Windows(Fichiers.Name).Activate
        Application.CutCopyMode = False
        ActiveWorkbook.Close savechanges:=False
     
        Application.ScreenUpdating = True
        End If
         
    Next
    a = a + 5
     
    Next
     
End Sub
 
 
quand il arrive sur Set Wb = Workbooks.Open(Fichiers.Name) , ya bien nom de fichier qui apparaît mais il me dit que mon fichier en .xls est introuvable ???
la partie en italique c'est les copier/coller d'un fichier à l'autre
 
merci

il n'aime pas le .Name en fait
mais tjs le même pb de boucle. pour l'instant j'ai fais un test avec 5 fichiers mais je peux en avoir moins ou plus (30 maxi), il ouvre les 5 fichiers mais recommence et ma variabe a prend +6 du coup au lieur de 5 quand il recommence !!

Deja c'est illisible sans balis [cpp ]] [/cpp ]
sans espace
 
Ensuite a quoi sert ta 1ere boucle de 12 a 157 ??

Le code fourni est on ne peut plus clair, l'as tu testé au moins ?

en fait c le fichier où je viens coller les valeurs que je récupère !!!
je commence en colonne 12 et après je me décales de 5 pour coller la colonne du fichier suivant ...
 
 
oui je l'ai testé mais j'ai du me tromper dans les modifs

bonjour
 
j'ai trouvé peut être une solution mais je sais pas comment l'écrire en VBA
 
est-ce qu'il serait possible de faire une MsgBox pour avertir l'utilisateur du fichier (vu qu'il ouvre plusieurs fois les fichiers) de dire attention ce fichier est déjà ouvert, voulez-vous l'ouvrir à nouveau? Oui-->il continue     et Non la macro s'arrête
 
 
merci

j'ai réussi à résoudre le pb
 
encore merci dje69r

Et ca venait d'où ?

disons que j'ai contourné le pb avec une MsgBox
je gardes les fichiers ouverts et comme il bouclé tjs j'ai mis un message qui me dit que le fichier est déjà ouvert. Du coup si je clique sur NON, ça Exit Sub !!! et juste avant de faire Exit, il ferme tout les autres fichiers
 
j'avoue c pas super comme solution mais sa marche :-)