Discussion :

[jaromyr]

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 dans mon code car il 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.

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
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

[pgz]

Bonjour.

Beaucoup de .ScrollRow là-dedans...

Pour ton pb, je crois que tu n'utilises pas la variable Fichier dans le QueryTables.Add, ce qui est dommage puisque c'est elle qui est sensée contenir successivement chaque nom de fichier.

Bon courage,

PGZ

[mordrhim]

Bonjour,

Afin de pouvoir t'aider au mieux pourrais tu préciser ce que ton programme est sensé faire ?

Je suppose que tu as "fait" ta macro avec l'enregistreur non ?

[jaromyr]

Bonjour.

Beaucoup de .ScrollRow là-dedans...

Pour ton pb, je crois que tu n'utilises pas la variable Fichier dans le QueryTables.Add, ce qui est dommage puisque c'est elle qui est sensée contenir successivement chaque nom de fichier.

Bon courage,

PGZ

Bonjour,
c'est gentil à vous de me répondre.. comment dois je formuler le QueryTable pour qu'il prenne en compte des lots d'images tif et non pas une liste définis d'images.

Oui, effectivement, il y a pas mal de .ScrollRow mais étant vraiment débutant, je n'ai pas pour l'instant trouvé mieux. Comment peut-on faire pour maximiser le code.

Encore merci.

Ji

[jaromyr]

Bonjour,

Afin de pouvoir t'aider au mieux pourrais tu préciser ce que ton programme est sensé faire ?

Je suppose que tu as "fait" ta macro avec l'enregistreur non ?

Bonjour,
merci pour votre aide. Oui effectivement, j'avoue?? cette macro a été effectué avec l'enregistreur puisque me considérant comme débutant je n'ai pas les bases suffisantes pour écrire le code directement.
Mon code doit permettre d'afficher certaines informations - "métadonnées exif" - liées à des images tif.

Ji

[pgz]

Bonjour.



Un truc du genre

Code :

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

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

A mettre au point.
Pour le reste, il y a sûrement du nettoyage à faire.

Bon courage,

PGZ

[jaromyr]

Bonjour,
merci pour votre aide.. Effectivement ce code est lourd. Je viens d'enlever tous les .ScrollRow. Cependant, je ne vois pas comment je dois faire pour n'avoir que certaines informations dans les lignes en sachant que qu'elles ne sont pas tous au même à la même ligne..?

Ji

[mordrhim]

comment sont organisés tes package de fichier .TIF ?

Un petit bout de code à adapter pour traiter des fichiers présent dans un dossier et ses sous dossiers
PathFichiers : Le dossier et ses sous dossier à regarder "C:\Dossier\SousDossier\...\etc\"
ExtensionFichiers : Extension des fichiers à compter "*.extension"

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
Sub ListerFichierTif()
    Dim PathFichiers As String, ExtensionFichiers As String
 
    ExtensionFichiers = InputBox("Extension des fichiers")
    PathFichiers = InputBox("Chemin des fichiers")
    k = 0
    With Excel.Application.FileSearch
        .NewSearch
        .LookIn = PathFichiers
        .SearchSubFolders = True
        .Filename = "*.tif"
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                MsgBox .FoundFiles(i)
                k = k + 1
            Next
        End Id
    End With
    MsgBox "Il y a " & k & " Fichier(s) " & ExtensionFichiers & " dans " & PathFichiers 
End Sub

[jaromyr]

Bonjour,
je ne comprends pas bien l'utilisation de ce code.. pouvez vous m'expliquer..
Merci

Ji