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

Signaler
Messages postés
1
Date d'inscription
mardi 2 octobre 2007
Statut
Membre
Dernière intervention
12 décembre 2007
-
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
-
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

Messages postés
182
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
14 mars 2011

t'es pas sur le bon forum
Messages postés
3877
Date d'inscription
mardi 19 mars 2002
Statut
Membre
Dernière intervention
23 août 2018
19
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²