Débutant - VBA excell : problème de boucle

jaromyrjarr Messages postés 1 Date d'inscription mardi 2 octobre 2007 Statut Membre Dernière intervention 12 décembre 2007 - 11 déc. 2007 à 15:40
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 - 11 déc. 2007 à 23:40
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..


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

2 réponses

cs_kazer04 Messages postés 182 Date d'inscription jeudi 14 juillet 2005 Statut Membre Dernière intervention 14 mars 2011
11 déc. 2007 à 17:19
t'es pas sur le bon forum
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
11 déc. 2007 à 23:40
Il faudrait que tu expliques ce que tu entends par "mettre en boucle" (?)
Tu as plusieurs fichiers tif à ouvrir ? et tu veux faire exactement les mêmes manipulations sur chacun ?

Tu utilises une variable Fichier. C'est elle que tu dois ouvrir.
>>>  Fichier = Dir(Chemin & "\*.tif")
Workbooks.OpenText Filename:=Fichier et le reste que tu as mis en commentaire

Pour Windows(Fichier), ça risque de ne pas fonctionner. Il faudra que tu enlèves le chemin de la variable Fichier pour pouvoir utiliser Windows()


Tous les ActiveWindow.ScrollRow

tu peux les virer ... ça ne sert à rien

MPi²
Rejoignez-nous