Bonjour ,
Pouvez vous m'aider, on m'a donné cette macro, mais elle ne fonctionne pas :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
Sub LECTURE_CTM()
'
' Macro enregistrée le 12/07/2012 par Jam
 Dim Dossier As Object, Fichier As Object
 Dim Chemin As String
 Dim I As Long
 
 Worksheets("DV").Columns("A:A").ClearContents
 Worksheets("HF").Columns("A:A").ClearContents
 
'DEV
 Chemin = "C:\CTM\DV"
 I = 0
 Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
 For Each Fichier In Dossier.Files
   I = I + 1
   Worksheets("DV").Cells(I, 1) = Fichier.Name ' Nom du fichier
 Next
 
'HF
 Chemin = "C:\CTM\HF"
 I = 0
 Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
 For Each Fichier In Dossier.Files
   I = I + 1
   Worksheets("HF").Cells(I, 1) = Fichier.Name ' Nom du fichier
 Next
 
End Sub
Sub LECTURE_FICHES()
'
' Macro enregistrée le 14/07/2012 par Jam
 Dim Dossier As Object, Fichier As Object
 Dim Chemin As String
 Dim I As Integer
 
 Worksheets("FICHES").Cells.ClearContents
 
'DEV
 Chemin = "C:\CTM\DV\"
 I = 1
 Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
 For Each Fichier In Dossier.Files
   I = I + 1
   Worksheets("FICHES").Cells(I, 1) = Fichier.Name ' Nom du fichier
 
   Open Chemin & Fichier.Name For Input As #1
     Do While Not EOF(1)    ' Effectue la boucle jusqu'à la fin du fichier.
       Input #1, MaLigne
 
       Extract_Value MaLigne, "##JOB      :", I, 3
       Extract_Value MaLigne, "##MEMNAME  :", I, 4
       Extract_Value MaLigne, "##DESCRIPT :", I, 5
       Extract_Value MaLigne, "##GROUPE   :", I, 6
       Extract_Value MaLigne, "##INTERVAL :", I, 7
       Extract_Value MaLigne, "##MAXWAIT  :", I, 8
       Extract_Value MaLigne, "##HEUREMINI:", I, 9
       Extract_Value MaLigne, "##HEUREMAXI:", I, 10
       Extract_Value MaLigne, "##JOURMOIS :", I, 11
       Extract_Value_Multiple MaLigne, "##JOURS    :", I, 12
       Extract_Value_Multiple MaLigne, "##CONDIN   :", I, 13
       Extract_Value_Multiple MaLigne, "##CONDOUT  :", I, 14
      'La colonne 15 est reservee au condition delete
       Extract_Value MaLigne, "##PARAM    :%%PARM4=", I, 16
 
     Loop
   Close #1
 
   If Right(Worksheets("FICHES").Cells(I, 3), 3) = "_S2" Or Right(Worksheets("FICHES").Cells(I, 3), 3) = "_D2" Then
      Worksheets("FICHES").Cells(I, 2) = "APRES BASCULE"
      Worksheets("FICHES").Cells(I, 16) = Worksheets("FICHES").Cells(I, 16) & "_CHG2"
   Else
      Worksheets("FICHES").Cells(I, 2) = "AVANT BASCULE"
   End If
   If Worksheets("FICHES").Cells(I, 4) <> "AMDlance.ksh" Then
      Worksheets("FICHES").Rows(I & ":" & I).ClearContents
      I = I - 1
   End If
 
 Next
 
 'Worksheets("FICHES").Columns("D:D").Delete Shift:=xlToLeft
 
End Sub
Sub Extract_Value(LaLigne, Prefixe As String, NumLig As Integer, NumCol As Integer)
 
  If Left(LaLigne, Len(Prefixe)) = Prefixe Then
     Worksheets("FICHES").Cells(NumLig, NumCol) = Right(LaLigne, Len(LaLigne) - Len(Prefixe))
  End If
End Sub
Sub Extract_Value_Multiple(LaLigne, Prefixe As String, NumLig As Integer, NumCol As Integer)
 
   If Left(LaLigne, Len(Prefixe)) = Prefixe And Right(LaLigne, 3) <> "DEL" Then
      Histo = Worksheets("FICHES").Cells(NumLig, NumCol)
      If Histo <> "" Then: Sep = ";"
      Worksheets("FICHES").Cells(NumLig, NumCol) = Histo & Sep & Right(LaLigne, Len(LaLigne) - Len(Prefixe))
   End If
  'Cas particulier CONDITION OUT DEL
   If Left(LaLigne, Len(Prefixe)) = Prefixe And Right(LaLigne, 3) = "DEL" Then
      Histo = Worksheets("FICHES").Cells(NumLig, NumCol + 1)
      If Histo <> "" Then: Sep = ";"
      Worksheets("FICHES").Cells(NumLig, NumCol + 1) = Histo & Sep & Right(LaLigne, Len(LaLigne) - Len(Prefixe))
   End If
 
End Sub