Comptage de fichiers consolides

Question

J'aurais besoin de vos lumieres svp. J'ai une macro qui consolide les donnees d'un certain nombre de fichiers. A travers un tableau croise dynamique j'ai le nombre de lignes importees mais ce que je voudrais c'est un comptage du nombre de fichiers dans mon folder source. Quelqu'un peut-il me renseigner svp...

Theze · Answer

Sub Test() MsgBox CompterFichiers("D:\Mon Dossier") '&lt;-- à adapter ! End Sub Function CompterFichiers(Dossier As String) As Long Dim Fichier As String Dim I As Long If Right(Dossier, 1) &lt;&gt; "\" Then Dossier = Dossier &amp; "\" 'seulement les fichiers Excel Fichier = Dir(Dossier &amp; "*.xls*") Do While (Len(Fichier) &gt; 0) I = I + 1 Fichier = Dir() Loop CompterFichiers = I End Function...

Theze · Answer

Tu veux faire quoi au juste ? Si tu veux savoir par l'intermédiaire d'un message le nombre de fichiers Excel qu'il y a dans le dossier cible une fois ta procédure finie, tu place la ligne ci-dessous en fin de procédure. Attention, ça ne veut pas dire pour autant que tous les classeurs présents dans ce dossier ont bien été traités par ton code ! Si tu n'y arrives pas, montre ton code. MsgBox CompterFichiers("D:\Mon Dossier") '&lt;-- à adapter le chemin ...

Theze · Answer

Re,

J'ai intégré le code de façon à ce que ce soit affiché dans ta boite de message en fin de procédure :

Private moShConso As Worksheet

Public Sub Conso()

Dim iDerLig As Integer
Dim sRep As String
Dim oFSO As FileSystemObject
Dim oFic As File
Dim NbFichiers As Integer
Dim I As Integer

sRep = ChoixDossier

If sRep = "" Then
Exit Sub
End If

Set oFSO = New FileSystemObject

'Set moShConso = Worksheets(1)
Set moShConso = Worksheets("Sheet1")
'fichier conso

'RAZ
If MsgBox("Voulez-vous effacer toutes les données ?", vbYesNo + vbExclamation) = vbYes Then
iDerLig = moShConso.Range("A" & Rows.Count).End(xlUp).Row
If iDerLig >= 3 Then
moShConso.Rows("3:" & iDerLig).Delete
End If
End If

'Import
For Each oFic In oFSO.GetFolder(sRep).Files 'parcours du répertoire

    Importer oFic.Path
    NbFichiers = NbFichiers + 1 'incrémente à chaque passage

Next oFic

Set oFSO = Nothing
Set moShConso = Nothing

I = CompterFichiers(sRep) 'compte le nombre de classeurs Excel dans le dossier

MsgBox "MAJ terminée !" & vbCrLf & NbFichiers & IIf(NbFichiers > 1, " fichiers sur " & I & " ont été importés !", " fichier sur " & I & " a été importé !"), vbExclamation

End Sub

Private Sub Importer(psFichier As String)

Dim oWB As Workbook
Dim oSh As Worksheet
Dim iEcr As Integer
Dim iLig As Integer
Dim iDerLig As Integer
'V0.2
Const S_NOM_ONGLET As String = "TDD"
'V0.2-fin

Set oWB = Workbooks.Open(psFichier, , True)
'V0.2-fin
'Set oSh = oWB.Worksheets(1)
'vérif onglet existe
If Not OngletExist(oWB, S_NOM_ONGLET) Then
MsgBox "Onglet inexistant : " & S_NOM_ONGLET & vbCrLf & vbCrLf & _
"Fichier : " & psFichier, vbExclamation
oWB.Close False
Set oWB = Nothing
Exit Sub
End If

Set oSh = oWB.Worksheets(S_NOM_ONGLET)
'V0.2-fin

iEcr = moShConso.Range("A" & Rows.Count).End(xlUp).Row + 1

iDerLig = oSh.Range("A" & Rows.Count).End(xlUp).Row

For iLig = 20 To iDerLig
'"PSS Name From line 4"
moShConso.Range("A" & iEcr).Value = oSh.Range("B4").Value
'"Bid submission date From line 11"
moShConso.Range("B" & iEcr).Value = oSh.Range("B11").Value
'"Revision Date From line 12"
moShConso.Range("C" & iEcr).Value = oSh.Range("B12").Value
'"Manufacturer From colonne E"
moShConso.Range("D" & iEcr).Value = oSh.Range("E" & iLig).Value
'"Supplier From colonne F"
moShConso.Range("E" & iEcr).Value = oSh.Range("F" & iLig).Value
'"Acquisition/Supply From colonne A"
moShConso.Range("F" & iEcr).Value = oSh.Range("A" & iLig).Value
'"Quote confidence level From colonne W"
moShConso.Range("G" & iEcr).Value = oSh.Range("W" & iLig).Value
'"Supply classification From colonne I"
moShConso.Range("H" & iEcr).Value = oSh.Range("I" & iLig).Value
'"Supplier Currency From colonne H"
moShConso.Range("I" & iEcr).Value = oSh.Range("H" & iLig).Value
'"Amount Supplier Currency From colonne M"
moShConso.Range("J" & iEcr).Value = oSh.Range("M" & iLig).Value
'"Amount in local currency From colonne N"
moShConso.Range("K" & iEcr).Value = oSh.Range("N" & iLig).Value
'"Amount in local currency From colonne C"
moShConso.Range("L" & iEcr).Value = oSh.Range("C" & iLig).Value

iEcr = iEcr + 1
Next iLig

oWB.Close False

Set oWB = Nothing
Set oSh = Nothing

End Sub

Function CompterFichiers(Dossier As String) As Long

    Dim Fichier As String
    Dim I As Long

    If Right(Dossier, 1) <> "\" Then Dossier = Dossier & "\"

    'seulement les fichiers Excel
   Fichier = Dir(Dossier & "*.xls*")

    Do While (Len(Fichier) > 0)

        I = I + 1

        Fichier = Dir()

    Loop

    CompterFichiers = I

End Function

Private Function ChoixDossier() As String

With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With

End Function