Problème de Boucle..

**jaromyr** · 11/12/2007, 14h34

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

**LeForestier** · 11/12/2007, 14h48

El l'image qui fonctionne elle est sur quel ligne ?
Et explique un peu le résultat final souhaité, parce je ne comprend pas où tu veux en venir.

**jaromyr** · 11/12/2007, 14h52

Bonjour,
Merci à vous de me répondre si rapidement.
L'image qui fonctionne bien se trouve à

' Workbooks.OpenText Filename:="S:\Cochlée nov 2007\1-07168a1_001.tif", Origin _

Il faut enveler l'ensemble des guillemets sur le paragraphe concerné.

Cordialement,

Ji

**LeForestier** · 11/12/2007, 14h55

Je remet en poste parce que tu à répondu pendant l'édit.
Et explique un peu le résultat final souhaité, parce je ne comprend pas où tu veux en venir.
Et à quoi servent tout les scroll.

**jaromyr** · 11/12/2007, 15h34

Envoyé par LeForestier

Je remet en poste parce que tu à répondu pendant l'édit.
Et explique un peu le résultat final souhaité, parce je ne comprend pas où tu veux en venir.
Et à quoi servent tout les scroll.

Bonjour LeForestier,
Ce que je demand de faire à cette macro est assez simple..
Télécharge le la pièce jointe sur cijoint.fr.
Ouvre l'une des images à partir d'Excell, va vers la fin du document et tu
veras une ensemble d'information avec des valeurs qui y sont rattachées.. comme par exemple:
[...]
Date=11/28/2007
Time=03:37:20 PM
User=supervisor
UserText=1_07168A1_001
UserTextUnicode=31005F0030003700310036003800410031005F00300030003100

[System]
Type=SEM
Dnumber=D8498
Software=3.0.7
DisplayHeight=0.303
[...]

L'objectif étant de récuperer les valeurs
[Beam]
==>HV=15000
==>Spot=3

[Stage]
==>WorkingDistance=0.00995933

[Vacuum]
==>UserMode=High vacuum

[Specimen]
==>Temperature=

[Detectors]
==>Name=ETD

En résumé, je souhaite que ma macro:
-ouvrir un fichier tif
-rechercher un "mot clé" dans ce fichier tif et son résultat
-copier le résultat de la recherche dans un autre classeur
-ainsi de suite ..
(J'ai 7 valeur à récuperer)
-enregistrer dans un premier format TXT
-enregistrer dans un format xls
-fermer
et boucler sur le reste des autres images tif

Merci encore pour votre aide,

Ji

**LeForestier** · 11/12/2007, 16h50

Bon, j'ai fini par charger ton classeur mais je ne sais rien tester vu que j'ai pas les images ni les mêmes chemins.
Tu à probablement une Excel 2003 ou 2007 car il y à des paramètres que je n'ai pas.
Il n'y à rien sur le classeur et la macro ne fonctionne pas avec ma version (2000).
Désolé, je suis obligé de passer la main à un autre contributeur.
A+

Problème de Boucle..

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager