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 82 83 84 85 86 87
| Function b2()
Dim repertoire As String
Dim fichier As String
Dim l As Integer
Dim i As Integer
Dim j As Integer
Application.DisplayAlerts = False
repertoire = "C:\Documents and Settings\FX056065\Bureau\Stage\Analyse existant\Contrôles\Fichiers controles + formalismes\TOUS LES FICHIERS CONTROLE"
fichier = ""
For l = 1 To 345
fichier = Sheets("Feuil1").Cells(l, 2).Value
If fichier <> "" Then
ChDir repertoire
Workbooks.Open Filename:=repertoire & "\" & fichier 'ouvre le fichier
Windows(fichier).Activate 'le met à l écran
'suite de tests
For i = 15 To 25
For j = 2 To 3
If Sheets(1).Cells(2, 1).Value = "Désignation :" Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 1"
Windows(fichier).Activate
objFSO.CopyFile repertoire & "\" & fichier, repertoire & "\Type 1\" & fichier, OverwriteExisting ElseIf Sheets(1).Cells(2, 2).Value = "REFERENCE: " And Sheets(1).Cells(1, 8).Value = "Désignation" Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 2"
ElseIf Sheets(1).Cells(2, 3).Value = "Désignation" And Sheets(1).Cells(3, 3).Value = "Référence" Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 3"
ElseIf Sheets(1).Cells(2, 2).Value = "REFERENCE: " And Sheets(1).Cells(1, 2).Value = "N° OF:" And Sheets(1).Cells(1, 17).Value <> 1 And Sheets(1).Cells(1, 29).Value = "" Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 4"
ElseIf Sheets(1).Cells(2, 2).Value = "REFERENCE: " And Sheets(1).Cells(1, 2).Value = "N° OF:" And Sheets(1).Cells(1, 17).Value = "N° OF:" Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 4bis"
ElseIf Sheets(1).Cells(2, 3).Value = "REFERENCE: " And Sheets(1).Cells(1, 3).Value = "N° OF:" Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 4tierce"
ElseIf Sheets(1).Cells(2, 2).Value = "REFERENCE: " And Sheets(1).Cells(2, 15).Value = "REFERENCE: " Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 4-4"
ElseIf Sheets(1).Cells(2, 2).Value = "REFERENCE: " And Sheets(1).Cells(2, 17).Value = "REFERENCE: " Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 4-5"
ElseIf Sheets(1).Cells(2, j).Value = "REFERENCE: " And Sheets(1).Cells(2, i).Value = "REFERENCE: " Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 4-i"
Cells(l, 4).Value = j
Cells(l, 5).Value = i
ElseIf Sheets(1).Cells(2, 2).Value = "REFERENCE: " And Sheets(1).Cells(1, 2).Value = "N° OF:" And Sheets(1).Cells(6, 1).Value = 1 Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 5"
ElseIf Sheets(1).Cells(2, 2).Value = "REFERENCE: " And Sheets(1).Cells(1, 2).Value = "LOT " Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 6"
ElseIf Sheets(1).Cells(2, 2).Value = "REFERENCE: " And Sheets(1).Cells(1, 2).Value = "N° OF:" And Sheets(1).Cells(1, 29).Value = "N° OF:" Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 8"
ElseIf Sheets(1).Cells(1, 3).Value = "OF n°" And Sheets(1).Cells(1, 28).Value = "N° piece" Then
Workbooks("Type de formalisme.xls").Activate
Cells(l, 3).Value = "Type 9"
End If
Next j
Next i
Windows("Type de formalisme.xls").Activate
Windows(fichier).Activate
ActiveWindow.Close 'ferme le fichier
Windows("Type de formalisme.xls").Activate
End If
Windows("Type de formalisme.xls").Activate
Next l
Application.DisplayAlerts = True
End Function |
Partager