Bonjour à tous,
n'arrivant pas en mettre en boucle ma macro, je vous demande votre aide.Elle fonctionne parfaitement sur 1 seule image.
Cette dernière sert à récuperer des informations précises dans un fichier TIF..

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Sub Macro1()
'
Dim Fichier As String, Chemin As String
Dim i As Long
 
Chemin = "C:\Cochlée nov 2007"
Fichier = Dir(Chemin & "\*.tif")
 
Do While Fichier <> ""
 
' jouvre mon image avec des delimiteur =
'    ChDir "S:\Cochlée nov 2007\"
'   Workbooks.OpenText Filename:="S:\Cochlée nov 2007\1-07168a1_001.tif", Origin _
'       :=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
'       xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
'       , Comma:=False, Space:=False, Other:=True, OtherChar:="=", FieldInfo _
'       :=Array(1, 2), TrailingMinusNumbers:=True
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 110
    ActiveWindow.ScrollRow = 407
    ActiveWindow.ScrollRow = 621
    ActiveWindow.ScrollRow = 694
    ActiveWindow.ScrollRow = 777
    ActiveWindow.ScrollRow = 881
    ActiveWindow.ScrollRow = 990
    ActiveWindow.ScrollRow = 1105
    ActiveWindow.ScrollRow = 1298
    ActiveWindow.ScrollRow = 1371
    ActiveWindow.ScrollRow = 1584
 [...]
 
    ClasseurN = Workbooks.Add.Name
 
    Windows("1-07168a1_001.tif").Activate 'je selectionne mon image ou je vais chercher
    Cells.Find(What:="HV", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
        , SearchFormat:=False).Activate
    Range("B4145").Select
    Selection.Copy
    Windows("ClasseurN").Activate
    Range("A2").Select
    ActiveSheet.Paste
 
    Windows("1-07168a1_001.tif").Activate
    Cells.Find(What:="Spot", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Activate
    Range("B4146").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("ClasseurN").Activate
    Range("B2").Select
    ActiveSheet.Paste
 
    Windows("1-07168a1_001.tif").Activate
    Cells.Find(What:="WorkingDistance", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
    Range("B4223").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("ClasseurN").Activate
    Range("C2").Select
    ActiveSheet.Paste
 
    Windows("1-07168a1_001.tif").Activate
    Cells.Find(What:="ChPressure", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
    Range("B4236").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("ClasseurN").Activate
    Range("D2").Select
    ActiveSheet.Paste
 
    Windows("1-07168a1_001.tif").Activate
    Cells.Find(What:="UserMode", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
    Range("B4238").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("ClasseurN").Activate
    Range("E2").Select
    ActiveSheet.Paste
 
    Windows("1-07168a1_001.tif").Activate
    Cells.Find(What:="Temperature", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=True, SearchFormat:=False).Activate
    Range("B4241").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("ClasseurN").Activate
    Range("F2").Select
    ActiveSheet.Paste
 
    'Idem avec Name
    Windows("1-07168a1_001.tif").Activate
    Cells.Find(What:="Name", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        True, SearchFormat:=False).Activate
    Range("B4245").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("ClasseurN").Activate
    Range("G2").Select
    ActiveSheet.Paste
 
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:="S:\Cochlée nov 2007\extraction.txt", _
        FileFormat:=xlText, CreateBackup:=False
 
    ActiveWorkbook.SaveAs Filename:="S:\Cochlée nov 2007\reception_extract.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
 
    Windows("macro1.xls").Activate
 
Fichier = Dir
Loop
End Sub

Je vous joins également le fichier en question.

http://www.cijoint.fr/cij16376075634406.zip


Merci par avance pour votre aide,

Ji