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

Débutant - problème de Boucle ou de End if ..

11 réponses
Avatar
ji
Bonjour à tous,
J'ai créer en tout bien et tout honneur ce petit script afin qu'il récupére
certaines données liées à des images tif.
Cependant, il existe un problème de boucle ou de end if caril me repete
bêtement l'information que je demande et ne passe pas à la l'image tif
suivante..

Je n'arrive pas à cibler l'erreur pour corriger cela..
Voici le code en question.

-------------------------------------------
Sub macro_final()
'
' macro_final Macro
'

'

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

'Répertoire contenant les photos
Chemin = "C:\scriptmeb"
Fichier = Dir(Chemin & "\*.tif")

Do While Fichier <> ""

With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\scriptmeb\HI 07035 A.tif", Destination:=Range("A1"))
.Name = "HI 07035 A"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 171
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(2, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Rows("80:80").Select
ActiveWindow.SmallScroll Down:=-12
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 47
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 44
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 42
ActiveWindow.ScrollRow = 41
ActiveWindow.ScrollRow = 39
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollRow = 1
Range("80:80,3:78").Select
Range("A3").Activate
ActiveWindow.SmallScroll Down:=15
Range("80:80,3:78,80:90,91:91,93:93").Select
Range("A93").Activate
ActiveWindow.SmallScroll Down:=12
Range("80:80,3:78,80:90,91:91,93:93,95:96,98:100,102:122").Select
Range("A102").Activate
ActiveWindow.SmallScroll Down:=-126
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-204
Selection.EntireRow.Hidden = True
ActiveWindow.SmallScroll Down:=-42
ActiveWorkbook.Save
'End Sub

Fichier = Dir
Loop
End Sub
----------------------------------


Merci par avance quant à votre aide,

Ji

1 réponse

1 2
Avatar
ji
Bonjour Misange,
j'ai donc réussi à faire ce que je souhaitais faire et à obtenir le résultat
que je voulais...Il ne fonctionne qu'avec qu'une seule image. Attention, il
faut changer le lettre du disque.. ce n'est pas S mais C:dossier zip
Vous serait il possible de jeter un coup d'oeil.. afin de me dire ce que
vous en pensez et comment peut on maximiser ce code car il est vraiment
lourd..je crois qu'il y a moyen de le faire..

Il est disponible à l'adresse suivante:
http://dl.free.fr/jFbt2ACIR/Cochléenov2007.zip

Il y a de amélioration à apporter serait il possible que vous m'aidiez..

Merci quant à votre précieuse aide,

Ji


Bonjour,

Désolée mais là il faut passer un temps que je n'ai pas pour résoudre
votre problème.
En revanche j'ai une solution de rechange à vous proposer : téléchargez
l'excellent (et gratuit) exif viewer.
Autre solution, reprenez le classeur mp-exifdata et décortiquez le pour
sortir les infos exif que vous recherchez.
Encore une solution : il y a un module de classe pour access qui permet
d'importer dans access directement.
http://excel.developpez.com/sources/?page=Images#vba_PhotosExif

Je ne comprends pas votre remarque : "La difficulté réel c’est qu’elle pèse
similairement la même chose mais les informations ne se trouve
toujours à la

même place..heureusement c’est toujours les mêmes métadonnées."
Quand je regarde les données de deux images, j'ai bien la même liste de

métadonnées, évidemment avec des valeurs différentes.
Une solution serait peut être dans votre cas tout simplement de lire ce
fichier texte :
http://www.excelabo.net/excel/sortirimport.php#lireecriretexte
et de repérer les [Beam] ou autres tags pour commencer à importer les
données qui vous intéressent.

Bon courage !
Ce serait sympa si vous trouvez une solution de venir la partager ici.


Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Bonjour Misange,
Pardonnez moi pour ne pas vous avoir donné plus d’information la dernière
fois.

Dans le dossier que vous trouverez en pièce jointe, il est nécessaire de le
mettre à la racine du disque C ou alors de changer le chemin d‘accès des
fichiers images dans le fichier Excell..vous trouverez dans ce fameux fichier
:
- 4 images en tiff provenant de microscope
- Un fichier excell (à 3 feuilles)
- La base de données
- le fichier excell "lireinfojpg", ne sert à rien ce n'est qu'un test..


- Les quatre images sont là pour démontrer le complexité de récupérer les
données. Lorsque vous ouvrez ces images avec le bloc note, et allez vers la
fin du fichier, nous trouvons les « métadonnées » dont j’ai besoin et qu’il
faut re transposer dans la base access. La difficulté réel c’est qu’elle pèse
similairement la même chose mais les informations ne se trouve toujours à la
même place..heureusement c’est toujours les mêmes métadonnées.

- le fichier excell est composé de 3 feuilles. La première feuille avec un
bouton extrait l’ensemble des métadonnées des images contenus dans le dossier
c:/meb. Et les affichent dans la feuille 1. Si vous essayer images et en
incrémenter une ca marche. Sauf pour 07048-trap-2-001 car les info se trouve
trop loin par rapport aux autres. (je ne sais pas si vous comprenez bien..)

La feuille 2 doit normalement récupérer les métadonnées dont j’ai besoin (7
au total) qui sont :

HV,
Spot,
Name
WorkingDistance,
ChPressure,
UserMode,
Temperature

La troisième feuille ce n’est qu’un essai « d’attachement » que j’ai
effectué avec la base access..

-je vous ai joins la base access pour vous montrer comment elle se
représentait, comment elle se structurait..en sachant que ne peut pas y
toucher ou plutôt qu’il faut y toucher le moins possible..

Merci encore pour votre aide et votre gentillesse,

Agréable fin de journée,

Ji



Je ne comprends pas grand chose à ce que vous faites et à ce qu'il y a
dans le zip.
Dans le classeur lireinfojpg, vous récupérez les données exif (mais il
me semble qu'il en manque beaucoup !) pour chacun des fichiers du dossier)
vous ne dites pas ce qui ne va pas dans ce classeur
Dans le second, il y a une liste en feuille 3 mais votre macro ne la
génère pas du tout.
Désolée mais je ne vois pas trop comment vous aider !
Misange







1 2