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
|
Sub planning()
'-----------------------------------------------------------------------------------------
' Déclarations
'-----------------------------------------------------------------------------------------
Dim Fso As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim Nchaine, Ndebut, Nfin As String
Dim Mchaine, Mdebut, f1mois As String
Dim name, namechemin As String
Dim Repertoire As String
Dim fPnom, f1nom As String
Dim DerLig1, Lig1 As Long
Dim LigBo, DerCel, DerCel1 As Long
'-----------------------------------------------------------------------------------------
' Traitements
'-----------------------------------------------------------------------------------------
Repertoire = "C:\Documents and Settings\squallihoussainin\Bureau\Macros\Fichier Source\RMA et facturation\2008\2008-10\RMA\"
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
name = FileItem.name
namechemin = Repertoire & FileItem.name
'fnom renvoie le nom extrait du nom de fichier
Nchaine = FileItem.name
Ndebut = InStr(1, Nchaine, " ", vbTextCompare) + 1
Nfin = InStr(1, Nchaine, "_", vbTextCompare)
f1nom = Mid(Nchaine, Ndebut, Nfin - Ndebut)
'fmois renvoie le mois extrait du nom du fichier
Mchaine = FileItem.name
Mdebut = Right(Mchaine, 9)
f1mois = Mid(Mdebut, 1, 2)
'rendre les mois en nombre en alphabet
If f1mois = "10" Then
f1mois = "Octobre"
End If
With Sheets("Plannings Absences")
For Lig1 = 517 To 553
'fPnom renvois le nom dans la feuille planning
Pchaine = .Range("A" & Lig1).Value
Pdebut = InStr(1, Pchaine, " ", vbTextCompare)
fPnom = Mid(Pchaine, 1, Pdebut)
Workbooks.Open (namechemin)
If f1nom = fPnom Then
MsgBox ("c bon")
Workbooks(name).Close SaveChanges:=False
End If
Next Lig1
End With
Next FileItem
End Sub |
Partager