1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
| Private Sub CommandButton1_Click()
racine = ChoixDossier()
UserForm4.Rep = racine
End Sub
Private Sub CommandButton2_Click()
UserForm4.Hide
Dim i As Long
Dim Recherche As ClFileSearch.ClasseFileSearch
Z = Feuil4.Cells(5, 8)
Set Recherche = ClFileSearch.Nouvelle_Recherche
'Set fichcherche = Application.FileSearch
With Recherche
.FolderPath = UserForm4.Rep 'Changer le chemin
.SubFolders = UserForm4.CheckBox1.Value
.SortBy = sort_Name
.Extension = "*.xls"
If .Execute > 0 Then
MsgBox .FoundFilesCount & " Fichiers(s) a (ont) été trouvé(s)."
Application.ScreenUpdating = False
'lignevide
For xx = 25 To 65000
If Feuil4.Cells(xx, 2) = "" Then
Index22 = xx - 1
Exit For
End If
Next xx
For i = 1 To .FoundFilesCount
'MsgBox .Files(i).strNom
NOMFICH = .Files(i).strChemin & "\" & .Files(i).strNom
Set xls = Workbooks.Open(NOMFICH, 0, True)
On Error Resume Next
xls.Worksheets("BASE LOCAUX").Activate
'indexfin
For ty = 7 To 65000
If xls.Worksheets("BASE LOCAUX").Cells(ty, 5) = "" Then
indexfin = ty - 1
Exit For
End If
Next ty
'Coûts standards
If xls.Worksheets("BASE LOCAUX").Cells(indexfin, 150) <> 0 Then
For yt = 7 To indexfin
If (xls.Worksheets("BASE LOCAUX").Cells(yt, 3) = Feuil4.Cells(Index22,3)) Then
Feuil4.Cells(Index22, 3) = xls.Worksheets("BASE LOCAUX").Cells(yt, 44)
End If
Next yt
End If
xls.Close savechanges:=False
Set xls = Nothing
Next i
Feuil4.Cells(5, 8) = Z
Application.ScreenUpdating = True
Else
MsgBox ("Pas de fichiers trouvés")
End If
End With
End Sub |
Partager