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

Question

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

cs_kazer04 · Answer

t'es pas sur le bon forum

cs_MPi · Answer

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²

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

2 réponses

Votre réponse

Discussions similaires