Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Débutant - Problème de Boucle une récupération de données

27 réponses
Avatar
ji
Bonjour à tous,
Ayant avancer sur ma problèmatique sur ce forum (grâce à Misange), je
n'arrive pas en mettre en boucle ma macro..
Cette dernière sert à récuperer des données précises dans un fichier TIF..
En voici le code:

Sub Macro1()

Dim Fichier As String, Chemin As String
Dim i As Long

'Répertoire contenant les photos
Chemin = "S:\Cochlée nov 2007"
Fichier = Dir(Chemin & "\*.tif")

'execution en boucle de tous les fichiers en tif
Do While Fichier <> ""

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Chemin & "\" & Fichier, Destination:=Range("A1"))

'ANCIEN jouvre mon image avec des delimiteur =
'ANCIEN ChDir "S:\Cochlée nov 2007"
'ANCIEN Workbooks.OpenText Filename:="S:\Cochlée nov
2007\1-07168a1_001.tif", Origin _
'ANCIEN :=xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier:= _
'ANCIEN xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False,
Semicolon:=False _
'ANCIEN , Comma:=False, Space:=False, Other:=True, OtherChar:="=",
FieldInfo _
'ANCIEN :=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
' ActiveWindow.ScrollRow = 1824
' ActiveWindow.ScrollRow = 1964
' ActiveWindow.ScrollRow = 2131
' ActiveWindow.ScrollRow = 2193
' ActiveWindow.ScrollRow = 2266
' ActiveWindow.ScrollRow = 2303
' ActiveWindow.ScrollRow = 2318
' ActiveWindow.ScrollRow = 2324
' ActiveWindow.ScrollRow = 2339
' ActiveWindow.ScrollRow = 2344
' ActiveWindow.ScrollRow = 2355
' ActiveWindow.ScrollRow = 2360
' ActiveWindow.ScrollRow = 2365
' ActiveWindow.ScrollRow = 2370
' ActiveWindow.ScrollRow = 2376
' ActiveWindow.ScrollRow = 2381
' ActiveWindow.ScrollRow = 2391
' ActiveWindow.ScrollRow = 2396
' ActiveWindow.ScrollRow = 2402
' ActiveWindow.ScrollRow = 2412
' ActiveWindow.ScrollRow = 2422
' ActiveWindow.ScrollRow = 2428
' ActiveWindow.ScrollRow = 2438
' ActiveWindow.ScrollRow = 2443
' ActiveWindow.ScrollRow = 2459
' ActiveWindow.ScrollRow = 2469
' ActiveWindow.ScrollRow = 2480
' ActiveWindow.ScrollRow = 2495
' ActiveWindow.ScrollRow = 2501
' ActiveWindow.ScrollRow = 2511
' ActiveWindow.ScrollRow = 2527
' ActiveWindow.ScrollRow = 2542
' ActiveWindow.ScrollRow = 2553
' ActiveWindow.ScrollRow = 2568
' ActiveWindow.ScrollRow = 2584
' ActiveWindow.ScrollRow = 2599
' ActiveWindow.ScrollRow = 2610
' ActiveWindow.ScrollRow = 2620
' ActiveWindow.ScrollRow = 2631
' ActiveWindow.ScrollRow = 2636
' ActiveWindow.ScrollRow = 2646
' ActiveWindow.ScrollRow = 2657
' ActiveWindow.ScrollRow = 2662
' ActiveWindow.ScrollRow = 2667
' ActiveWindow.ScrollRow = 2672
' ActiveWindow.ScrollRow = 2683
' ActiveWindow.ScrollRow = 2693
' ActiveWindow.ScrollRow = 2709
' ActiveWindow.ScrollRow = 2735
' ActiveWindow.ScrollRow = 2756
' ActiveWindow.ScrollRow = 2771
' ActiveWindow.ScrollRow = 2792
' ActiveWindow.ScrollRow = 2813
' ActiveWindow.ScrollRow = 2829
' ActiveWindow.ScrollRow = 2855
' ActiveWindow.ScrollRow = 2886
' ActiveWindow.ScrollRow = 2912
' ActiveWindow.ScrollRow = 2938
' ActiveWindow.ScrollRow = 2969
' ActiveWindow.ScrollRow = 3006
' ActiveWindow.ScrollRow = 3032
' ActiveWindow.ScrollRow = 3047
' ActiveWindow.ScrollRow = 3068
' ActiveWindow.ScrollRow = 3084
' ActiveWindow.ScrollRow = 3094
' ActiveWindow.ScrollRow = 3105
' ActiveWindow.ScrollRow = 3120
' ActiveWindow.ScrollRow = 3131
' ActiveWindow.ScrollRow = 3136
' ActiveWindow.ScrollRow = 3146
' ActiveWindow.ScrollRow = 3151
' ActiveWindow.ScrollRow = 3162
' ActiveWindow.ScrollRow = 3172
' ActiveWindow.ScrollRow = 3188
' ActiveWindow.ScrollRow = 3198
' ActiveWindow.ScrollRow = 3209
' ActiveWindow.ScrollRow = 3214
' ActiveWindow.ScrollRow = 3224
' ActiveWindow.ScrollRow = 3240
' ActiveWindow.ScrollRow = 3271
' ActiveWindow.ScrollRow = 3308
' ActiveWindow.ScrollRow = 3323
' ActiveWindow.ScrollRow = 3344
' ActiveWindow.ScrollRow = 3360
' ActiveWindow.ScrollRow = 3375
' ActiveWindow.ScrollRow = 3396
' ActiveWindow.ScrollRow = 3412
' ActiveWindow.ScrollRow = 3422
' ActiveWindow.ScrollRow = 3433
' ActiveWindow.ScrollRow = 3443
' ActiveWindow.ScrollRow = 3506
' ActiveWindow.ScrollRow = 3552
' ActiveWindow.ScrollRow = 3651
' ActiveWindow.ScrollRow = 3714
' ActiveWindow.ScrollRow = 3776
' ActiveWindow.ScrollRow = 3875
' ActiveWindow.ScrollRow = 3969
' ActiveWindow.ScrollRow = 3979
' ActiveWindow.ScrollRow = 3985
' ActiveWindow.ScrollRow = 3990
' ActiveWindow.ScrollRow = 3995
' ActiveWindow.ScrollRow = 4000
' ActiveWindow.ScrollRow = 4016
' ActiveWindow.ScrollRow = 4026
' ActiveWindow.ScrollRow = 4032
' ActiveWindow.ScrollRow = 4042
' ActiveWindow.ScrollRow = 4052
' ActiveWindow.ScrollRow = 4068
' ActiveWindow.ScrollRow = 4078
' ActiveWindow.ScrollRow = 4084
' ActiveWindow.ScrollRow = 4089
' ActiveWindow.ScrollRow = 4094
' ActiveWindow.ScrollRow = 4099
' ActiveWindow.ScrollRow = 4104
' ActiveWindow.ScrollRow = 4110
' ActiveWindow.ScrollRow = 4115
' ActiveWindow.ScrollRow = 4120
' ActiveWindow.ScrollRow = 4125
' ActiveWindow.ScrollRow = 4130
' ActiveWindow.ScrollRow = 4136
' ActiveWindow.ScrollRow = 4130
' ActiveWindow.ScrollRow = 4125
' ActiveWindow.ScrollRow = 4120
' ActiveWindow.ScrollRow = 4125
' ActiveWindow.ScrollRow = 4130
' ActiveWindow.ScrollRow = 4136
' ActiveWindow.ScrollRow = 4141
' ActiveWindow.ScrollRow = 4136
' ActiveWindow.ScrollRow = 4125
' ActiveWindow.ScrollRow = 4120
' ActiveWindow.ScrollRow = 4110
' ActiveWindow.ScrollRow = 4099
' ActiveWindow.ScrollRow = 4089
' ActiveWindow.ScrollRow = 4068
' ActiveWindow.ScrollRow = 3985
' ActiveWindow.ScrollRow = 3797
' ActiveWindow.ScrollRow = 3500
' ActiveWindow.ScrollRow = 3412
' ActiveWindow.ScrollRow = 3276
' ActiveWindow.ScrollRow = 3073
' ActiveWindow.ScrollRow = 3000
' ActiveWindow.ScrollRow = 2865
' ActiveWindow.ScrollRow = 2803
' ActiveWindow.ScrollRow = 2678
' ActiveWindow.ScrollRow = 2615
' ActiveWindow.ScrollRow = 2568
' ActiveWindow.ScrollRow = 2516
' ActiveWindow.ScrollRow = 2464
' ActiveWindow.ScrollRow = 2422
' ActiveWindow.ScrollRow = 2344
' ActiveWindow.ScrollRow = 2266
' ActiveWindow.ScrollRow = 2188
' ActiveWindow.ScrollRow = 2089
' ActiveWindow.ScrollRow = 2063
' ActiveWindow.ScrollRow = 1969
' ActiveWindow.ScrollRow = 1834
' ActiveWindow.ScrollRow = 1782
' ActiveWindow.ScrollRow = 1740
' ActiveWindow.ScrollRow = 1730
' ActiveWindow.ScrollRow = 1725
' ActiveWindow.ScrollRow = 1714
' ActiveWindow.ScrollRow = 1699
' ActiveWindow.ScrollRow = 1683
' ActiveWindow.ScrollRow = 1667
' ActiveWindow.ScrollRow = 1647
' ActiveWindow.ScrollRow = 1594
' ActiveWindow.ScrollRow = 1459
' ActiveWindow.ScrollRow = 1345
' ActiveWindow.ScrollRow = 1266
' ActiveWindow.ScrollRow = 1230
' ActiveWindow.ScrollRow = 1157
' ActiveWindow.ScrollRow = 1121
' ActiveWindow.ScrollRow = 1089
' ActiveWindow.ScrollRow = 1063
' ActiveWindow.ScrollRow = 1037
' ActiveWindow.ScrollRow = 1011
' ActiveWindow.ScrollRow = 996
' ActiveWindow.ScrollRow = 980
' ActiveWindow.ScrollRow = 970
' ActiveWindow.ScrollRow = 954
' ActiveWindow.ScrollRow = 949
' ActiveWindow.ScrollRow = 938
' ActiveWindow.ScrollRow = 933
' ActiveWindow.ScrollRow = 928
' ActiveWindow.ScrollRow = 918
' ActiveWindow.ScrollRow = 912
' ActiveWindow.ScrollRow = 902
' ActiveWindow.ScrollRow = 860
' ActiveWindow.ScrollRow = 834
' ActiveWindow.ScrollRow = 803
' ActiveWindow.ScrollRow = 772
' ActiveWindow.ScrollRow = 740
' ActiveWindow.ScrollRow = 714
' ActiveWindow.ScrollRow = 683
' ActiveWindow.ScrollRow = 662
' ActiveWindow.ScrollRow = 642
' ActiveWindow.ScrollRow = 626
' ActiveWindow.ScrollRow = 610
' ActiveWindow.ScrollRow = 600
' ActiveWindow.ScrollRow = 589
' ActiveWindow.ScrollRow = 574
' ActiveWindow.ScrollRow = 558
' ActiveWindow.ScrollRow = 548
' ActiveWindow.ScrollRow = 537
' ActiveWindow.ScrollRow = 527
' ActiveWindow.ScrollRow = 501
' ActiveWindow.ScrollRow = 475
' ActiveWindow.ScrollRow = 444
' ActiveWindow.ScrollRow = 386
' ActiveWindow.ScrollRow = 324
' ActiveWindow.ScrollRow = 251
' ActiveWindow.ScrollRow = 173
' ActiveWindow.ScrollRow = 22
' ActiveWindow.ScrollRow = 6
' ActiveWindow.ScrollRow = 1

Workbooks.Add ' jouvre un nouveau classeur

'Je cherche HV dans limage je copie la valeur et je colle dans nouveau
classeur 1
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("Classeur1").Activate
Range("A2").Select
ActiveSheet.Paste

' Idem avec Spot
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("Classeur1").Activate
Range("B2").Select
ActiveSheet.Paste

'Idem avec WorkingDistance
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("Classeur1").Activate
Range("C2").Select
ActiveSheet.Paste

'Idem avec ChpPressure
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("Classeur1").Activate
Range("D2").Select
ActiveSheet.Paste

'Idem avec UserMode
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("Classeur1").Activate
Range("E2").Select
ActiveSheet.Paste

'Idem avec Temperature
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("Classeur1").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("Classeur1").Activate
Range("G2").Select
ActiveSheet.Paste

'jenregistre sous txt tabulaeur
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="S:\Cochlée nov 2007\Classeur1.txt", _
FileFormat:=xlText, CreateBackup:=False

'Jenregistre sous format excell
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

'End Sub


Je l'ai commenté afin qu'on puisse suivre que je souhaite faire et où je
veux aller..
J'ai un message d'erreur "Erreur de compilation : Boucle sans Do".
Pourriez vous me mettre sur la bonne voie.

Merci par avance

Cordialement,

Ji

7 réponses

1 2 3
Avatar
FFO
Rebonjours à toi

J'ai du mal à comprendre comment d'un fichier image on peux récupérer un mot
clé

J'ai besoin de plus de précision pour éventuellement t'aider et notamment où
se trouve ce mot clé dans cette image

Merci d'éclarer ma lanterne



Bonjour FFO,
Merci pour ta précieuse aide. J'ai regardé avec attention la macro que tu me
proposes.. elle est génial malheureusement elle s'inscript pas dans ce que je
souhaite faire et obtenir comme résultat..

Ce que je demande de faire et que l'on retrouve dans ma macro 1 c'est:
-ouvrir un fichier tif
-rechercher un mot clé dans ce fichier tif
-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

J'essaie de voir ce qui ne va pas..

Ji


Avatar
ji
Rebonjour FFO
C'est effectivement la difficultéà laquelle je suis confronté.. d'o mon
raisonnement..
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é.. comme
par exemple:
[...]
Date/28/2007
Time:37:20 PM
User=supervisor
UserText=1_07168A1_001
UserTextUnicode1005F0030003700310036003800410031005F00300030003100

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

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

[Stage]
==>WorkingDistance=0.00995933

[Vacuum]
==>UserMode=High vacuum

[Specimen]
==>Temperature
[Detectors]
==>Name=ETD

Je reste à ta disposition pour plus d'informations,

Milles merci,

Ji
Avatar
FFO
Rebonjour à toi

Pas simple ton affaire !!!!

Je pense que ce code devrait faire l'affaire
Toujours le lecteur C: pris en considération :

Dim Fichier As String, Chemin As String
Dim i As Long
ClasseurN = Workbooks.Add.Name
With Application.FileSearch
.LookIn = "C:Cochlée nov 2007"
.Filename = "*.tif"
.Execute
End With
With Application.FileSearch
For i = 1 To .FoundFiles.Count
ChDir "C:Cochlée nov 2007"
ChDir "C:Cochlée nov 2007"
Application.DisplayAlerts = False
Workbooks.OpenText Filename:="C:Cochlée nov 2007" &
Mid(.FoundFiles(i), Len(.LookIn) + 2), Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:=True,
Semicolon:úlse, _
Comma:úlse, Space:úlse, Other:úlse, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Columns("A:A").Find(What:="[Beam]", After:¬tiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell.Offset(1, 0).Value
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell.Offset(2, 0).Value
Columns("A:A").Find(What:="WorkingDistance", After:¬tiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell
Columns("A:A").Find(What:="UserMode", After:¬tiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell
Columns("A:A").Find(What:="Temperature", After:¬tiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell
Columns("A:A").Find(What:="Name", After:¬tiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell
Workbooks(Mid(.FoundFiles(i), Len(.LookIn) + 2)).Close SaveChanges:úlse
Next i
End With

Vu la longueur des lignes d'instruction tu seras trés certainement obligé
pour certaine d'entre elles de les réorganiser aprés le copier/coller dans
l'éditeur de Macro

J'ai choisi pour les premiers paramètres d'établir la recherche sur le mot
"[Beam]" les clés "HV" et "Spot" recherchées se retrouvent à de multiples
endroit dans la colonne donc impossible de se baser dessus
Ayant trouvé le mot "[Beam]" je récupère les clés dans les 2 cellules qui
suivent

Pour les autres clés la recherche est directement basé sur leur nom

Je te mets un lien où tu pourras récupérer mon document réalisé comme décrit

http://www.cijoint.fr/cij34907306034444.xls

Donne moi tes impressions !!!


Rebonjour FFO
C'est effectivement la difficultéà laquelle je suis confronté.. d'o mon
raisonnement..
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é.. comme
par exemple:
[...]
Date/28/2007
Time:37:20 PM
User=supervisor
UserText=1_07168A1_001
UserTextUnicode1005F0030003700310036003800410031005F00300030003100

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

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

[Stage]
==>WorkingDistance=0.00995933

[Vacuum]
==>UserMode=High vacuum

[Specimen]
==>Temperature >
[Detectors]
==>Name=ETD

Je reste à ta disposition pour plus d'informations,

Milles merci,

Ji




Avatar
ji
Bonsoir FFO
je regarde cela dans quelques instants et te fait un retour dès que c'est
fait ..
Merci milles fois

Ji


Rebonjour à toi

Pas simple ton affaire !!!!

Je pense que ce code devrait faire l'affaire
Toujours le lecteur C: pris en considération :

Dim Fichier As String, Chemin As String
Dim i As Long
ClasseurN = Workbooks.Add.Name
With Application.FileSearch
.LookIn = "C:Cochlée nov 2007"
.Filename = "*.tif"
.Execute
End With
With Application.FileSearch
For i = 1 To .FoundFiles.Count
ChDir "C:Cochlée nov 2007"
ChDir "C:Cochlée nov 2007"
Application.DisplayAlerts = False
Workbooks.OpenText Filename:="C:Cochlée nov 2007" &
Mid(.FoundFiles(i), Len(.LookIn) + 2), Origin _
:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:úlse, Tab:=True,
Semicolon:úlse, _
Comma:úlse, Space:úlse, Other:úlse, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
Columns("A:A").Find(What:="[Beam]", After:¬tiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell.Offset(1, 0).Value
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell.Offset(2, 0).Value
Columns("A:A").Find(What:="WorkingDistance", After:¬tiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell
Columns("A:A").Find(What:="UserMode", After:¬tiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell
Columns("A:A").Find(What:="Temperature", After:¬tiveCell,
LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell
Columns("A:A").Find(What:="Name", After:¬tiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:úlse, SearchFormat:úlse).Activate
Workbooks(ClasseurN).Sheets(1).Range("C65535").End(xlUp).Offset(1,
0).Value = ActiveCell
Workbooks(Mid(.FoundFiles(i), Len(.LookIn) + 2)).Close SaveChanges:úlse
Next i
End With

Vu la longueur des lignes d'instruction tu seras trés certainement obligé
pour certaine d'entre elles de les réorganiser aprés le copier/coller dans
l'éditeur de Macro

J'ai choisi pour les premiers paramètres d'établir la recherche sur le mot
"[Beam]" les clés "HV" et "Spot" recherchées se retrouvent à de multiples
endroit dans la colonne donc impossible de se baser dessus
Ayant trouvé le mot "[Beam]" je récupère les clés dans les 2 cellules qui
suivent

Pour les autres clés la recherche est directement basé sur leur nom

Je te mets un lien où tu pourras récupérer mon document réalisé comme décrit

http://www.cijoint.fr/cij34907306034444.xls

Donne moi tes impressions !!!


Rebonjour FFO
C'est effectivement la difficultéà laquelle je suis confronté.. d'o mon
raisonnement..
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é.. comme
par exemple:
[...]
Date/28/2007
Time:37:20 PM
User=supervisor
UserText=1_07168A1_001
UserTextUnicode1005F0030003700310036003800410031005F00300030003100

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

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

[Stage]
==>WorkingDistance=0.00995933

[Vacuum]
==>UserMode=High vacuum

[Specimen]
==>Temperature > >
[Detectors]
==>Name=ETD

Je reste à ta disposition pour plus d'informations,

Milles merci,

Ji






Avatar
ji
Bonjour FFO
Pardonne moi pour ce délai dans ma réponse. Merci beaucoup. T'es un chef..
La macro est parfaite et fonctionnel.. je cherche dans un prmeier temps à
comprendre comment elle est faite, et si je peut rajouter des 2 éléments de
plusà chercher.
Je te tiens au courrant si je modiifie quelques choses ou si je rencontre
des difficultés..
Si je puis me permettre, pourrais tu me mettres sur la piste de comment
integré ces donnes dans un base access. J'ai entendu parler de plusieurs
méthodes plus ou moins facile à mettre en oeuvre. La plus facile étant celle
de faire une simple requete via l'aide de requete de Excell. Qu'en penses tu
FFO?

Milles merci

Ji
Avatar
FFO
Rebonjour à toi

Pour rapatrier ces données dans une table d'une base access
Activer la référence "Microsoft Access 11.0 Object Library" dans
Outils/Références
Avec les données récupérées dans le classeur créé en colonne C à partir de
la cellule C2 Je te propose ce code :

Dim ObjAcc As Access.Application
Set ObjAcc = CreateObject("Access.Application")
ObjAcc.OpenCurrentDatabase "E:CheminBase.mdb"
ObjAcc.UserControl = True
AppActivate "Microsoft Access"
CurrentDb.Execute "delete from [Table]"
Workbooks("Nom du classeur ayant les données").Activate
Do While Sheets("Onglet ayant les données").Range("C2").Offset(i, 0) <> ""
CurrentDb.Execute "Insert into [Table](Nom du Champ)Values('" &
Sheets("Onglet ayant les données").Range("C2").Offset(i, 0).Value & "');"
i = i + 1
Loop
ObjAcc.CloseCurrentDatabase
ObjAcc.UserControl = False
ObjAcc.Application.Quit

A actualiser :

Chemin : le chemin de la base à alimenter
Table : le nom de la table de la base à alimenter
Nom du classeur ayant les données : le nom du classeur qui porte les données
récupérées
Onglet ayant les données : le nom de l'onglet qui porte les données récupérées
Nom du Champ : le nom du champ de la table de la base dans lequel les
données seront rapportées

Je pense que tu devrais être satisfait
Dis moi !!!!


Bonjour FFO
Pardonne moi pour ce délai dans ma réponse. Merci beaucoup. T'es un chef..
La macro est parfaite et fonctionnel.. je cherche dans un prmeier temps à
comprendre comment elle est faite, et si je peut rajouter des 2 éléments de
plusà chercher.
Je te tiens au courrant si je modiifie quelques choses ou si je rencontre
des difficultés..
Si je puis me permettre, pourrais tu me mettres sur la piste de comment
integré ces donnes dans un base access. J'ai entendu parler de plusieurs
méthodes plus ou moins facile à mettre en oeuvre. La plus facile étant celle
de faire une simple requete via l'aide de requete de Excell. Qu'en penses tu
FFO?

Milles merci

Ji


Avatar
ji
Bonjour FFO,
je viens de prendre connaissance de ton mel.. Merci à toi de me répondre si
rapidement et surtout pour la qualité de tes explications..

Je n'arrive pas bien à faire fonctionner la fonction, peut être que je fais
quelques choses de mal.. J'ai le message d'erreur suivant:
"Erreur de compilation : Type défini par l'utilisateur non défini". Est c
equ'il ne faut pas aller voir du côté Type et End Type

Je join l'adresse de l'ensemble du dossier zippé dans lequel tu trouveras:
- deux images tif (les mêmes qu'avant)
- la macro
- la base access
ATTENTION: il faut changer le lecteur C

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

Je m'intérrogeais sur la faisabilité de

- de mettre C2 edans un champs
- de mettre C3 et C4 dans un autre champs
et..


Milles mercis

Ji
1 2 3