Extraire certaines métadonnées d'images TIF

**jaromyr** · 24/10/2007, 11h08

Bonjour à tous,

Cela fait bientôt une semaine que je lis avec beaucoup de plaisir vos rubriques sur le VBA de manière à ce que le néofite que je suis, ne le soit plus dans ce domaine. Je tiens vraimentà saluer la richesse et la qualité des renseignements et des interventions qui sont faites sur ce forum. J'ai beaucoup appris et rapidement.

- Voici ma problèmatique:
je souhaiterai extraire des données d'images en Tif en provenance d'un microscope afin de les acheminer dans une base access.

- Mon raissonnement :

Etant débutant, je me suis dit qu'il était facile de demander à excell d'ouvrir un tiff et d'extraire des données dans un tableau puis ensuite de demander soit à access ou excell de remettre le tout dans ma base de données déjà constituée.

- Difficultés rencontrées en ordre croissant:
Dans le script vba ainsi construit j'aimerai

1) pouvoir appliquer cette extraction sur plusieurs images (et pas qu'une seul)
2) l'extraction ainsi réalisé pourvoir "convertir" de façon avoir sur une colone les parametres et sur une autre colone les résultats.
3) Peut être existe-il une solution plus direct en passant directement avec un script vba sous access..

- Mon script VBA :

________________________________________________

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 19/10/2007 par mathias
'
 
'
    Application.CommandBars("Stop Recording").Visible = False
    Application.Goto Reference:="Macro1"
 
    Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim waExcel: Set waExcel = CreateObject("Excel.Application") 'Ouverture d'Excel
    StrPath = "C:\scriptmeb\" 'Chemin d'accès du fichier
    If Right(StrPath, 1) <> "\" Then StrPath = StrPath & "\" 'Ajoute \ à la fin s'il y en a pas
    StrFich = "HI 07035 A.tif" 'Nom du fichier
    If FSO.FileExists(StrPath & StrFich) Then 'Existance du fichier
    waExcel.Visible = False 'Rendre invisible Excel
    'Importe le fichier texte vers une feuille Excel de façon Largeur fixe avec délimiteur : Tabulation et Space et =
    waExcel.Workbooks.OpenText StrPath & StrFich, , 151, 2, , , True, , , True, True, "="
    'waExcel.Workbooks.OpenText StrPath & StrFich, , , 2, , , , , ,
    'Sauvegarde la feuiller importer vers le chemin d'accès de départ en motifiant l'extension et en mode partagé pour éviter des erreurs
    waExcel.Workbooks(StrFich).SaveAs StrPath & Left(StrFich, Len(StrFich) - 4) & ".xls", , , , , , 2
    End If
    'Fermeture d'Excel
    waExcel.Application.Quit
 
 
End Sub

__________________________________________________

Je vous joins le script vba excell et une image afin que vous puissiez constater.

http://dl.free.fr/cnLrEECiQ/script_mathias.zip

Voili voilou,
Merci par avance quant à vos divers éléments de réponse.

Cordialement,

Jaromyr

**SilkyRoad** · 24/10/2007, 16h13

bonjour

1) pouvoir appliquer cette extraction sur plusieurs images (et pas qu'une seul)

Il suffit de créer une boucle sur les fichiers .tif d'un dossier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim Chemin As String, Fichier As String
 
Chemin = "C:\dossier\"
Fichier = Dir(Chemin & "*.tif")
 
Do While Len(Fichier) > 0
    Debug.Print Chemin & Fichier
    Fichier = Dir()
Loop

3) Peut être existe-il une solution plus direct en passant directement avec un script vba sous access..

ACCESS : Tutoriel d'utilisation de la classe ClExif
http://arkham46.developpez.com/artic...s/clexif/tuto/

Utiliser la librairie Windows Image Acquisition en VBA
II-B-1. Lister les propriétés d'une image
http://silkyroad.developpez.com/VBA/...ition/#LII-B-1

bon après midi
michel

**jaromyr** · 25/10/2007, 12h04

Envoyé par SilkyRoad

bonjour

Il suffit de créer une boucle sur les fichiers .tif d'un dossier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim Chemin As String, Fichier As String
 
Chemin = "C:\dossier\"
Fichier = Dir(Chemin & "*.tif")
 
Do While Len(Fichier) > 0
    Debug.Print Chemin & Fichier
    Fichier = Dir()
Loop

ACCESS : Tutoriel d'utilisation de la classe ClExif
http://arkham46.developpez.com/artic...s/clexif/tuto/

Utiliser la librairie Windows Image Acquisition en VBA
II-B-1. Lister les propriétés d'une image
http://silkyroad.developpez.com/VBA/...ition/#LII-B-1

bon après midi
michel

Bonjour,
c'est très gentil à vous de me répondre aussi rapidement..

Me considérant encore débutant, comment dois-je intégrer le code que vous m'avez fournie, dans le mien.. Lorsque je l'intégre, il ne le prend pas en compte.

Par ailleurs,j'ai lu avec attention l'ensemble de ressources que vous m'avez indiqué.
Cependant, cela ne conviendra pas puisque la base de données est constitué. il ne suffit plus que d'importer les données dans la base dans les différents champs de la table. (Mais c'est la deuxième partie de ma problématique ..

)

Pourriez vous m'orienter sur ce qu'il faudrait faire (ou plutot "coder)" pour ne selectionner que certaines informations dans le tif.

Merci encore à vous,

Cordialement,

Jaromyr

**jaromyr** · 31/10/2007, 09h46

Envoyé par SilkyRoad

bonjour

Il suffit de créer une boucle sur les fichiers .tif d'un dossier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim Chemin As String, Fichier As String
 
Chemin = "C:\dossier\"
Fichier = Dir(Chemin & "*.tif")
 
Do While Len(Fichier) > 0
    Debug.Print Chemin & Fichier
    Fichier = Dir()
Loop

bon après midi
michel

Bonjour,
Je reviens vers vous après quelques test sur l'ensemble sources que vous
m'avez fournies.
Voici le code que j'ai réussi à faire à ce jour..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Sub Macro8()
' HI 07035 B
' Macro8 Macro
'
 
'
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 = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 173
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "="
.TextFileColumnDataTypes = Array(1, 1)
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=-54
Rows("3:43").Select
ActiveWindow.SmallScroll Down:=-39
Rows("3:78").Select
Selection.Delete Shift:=xlUp
Rows("16:16").Select
ActiveWindow.SmallScroll Down:=-12
Range( _
 
"4:4,15:15,5:5,6:6,7:7,8:8,9:9,10:10,11:11,12:12,13:13,14:14,17:17,19:19,20:20,20:20,22:22" _
).Select
Range("A22").Activate
ActiveWindow.Zoom = 85
Range( _
 
"4:4,15:15,5:5,6:6,7:7,8:8,9:9,10:10,11:11,12:12,13:13,14:14,17:17,19:19,20:20,20:20,22:22,23:23,24:24,26:26" _
).Select
Range("A26").Activate
ActiveWindow.Zoom = 70
ActiveWindow.SmallScroll Down:=2
Range("B31").Select
ActiveWindow.SmallScroll Down:=-27
Rows("4:15").Select
Selection.Delete Shift:=xlUp
Rows("5:5").Select
Selection.Delete Shift:=xlUp
Rows("6:7").Select
Selection.Delete Shift:=xlUp
Rows("7:9").Select
Selection.Delete Shift:=xlUp
Rows("8:28").Select
Selection.Delete Shift:=xlUp
End Sub

Il ne manque une boucle pour pouvoir l'appliquer dans sur un ensemble
d'image. Sauriez vous m'indiquer la démarche..

Merci pour votre aide.

Cordialement,

Jaromyr

**SilkyRoad** · 31/10/2007, 18h17

bonsoir

tu pourrais essayer ce type de procédure

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim Chemin As String, Fichier As String
 
Chemin = "C:\dossier\"
Fichier = Dir(Chemin & "*.tif")
 
Do While Len(Fichier) > 0
    ThisWorkbook.Worksheets.Add
 
    'Debug.Print Chemin & Fichier
    With ActiveSheet.QueryTables.Add(Connection:= _
                Chemin & Fichier, Destination:=Range("A1"))
        .Name = Left(Fichier, Len(Fichier) - 4)
        '
        '
        '
    End With
 
    Fichier = Dir()
Loop

bonne soirée
michel

Extraire certaines métadonnées d'images TIF

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager