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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
Public Function MaJExifGpsTableImage() As Boolean
On Error GoTo MyErr
Dim oDb As DAO.Database, oRs As DAO.Recordset
Dim oExif As ClExif, oGps As GPSExifReader
Dim PathImage As String, ErrMsg As String, TmpMsg As String, i As Long
Set oExif = New ClExif
Set oGps = New GPSExifReader
Set oDb = CurrentDb
Set oRs = oDb.OpenRecordset("t_image", dbOpenTable)
With oRs
While Not .EOF
If Not (IsNull(!nomfichier) Or IsNull(!dossier)) Then
PathImage = !dossier & IIf(Right$(Trim$(!dossier), 1) <> "\", "\", "") & !nomfichier
.Edit
TmpMsg = setExifTableImage(oRs, oExif, PathImage)
TmpMsg = TmpMsg & setGPSTableImage(oRs, oGps, PathImage)
.Update
If Len(TmpMsg) = 0 Then i = i + 1 Else: ErrMsg = ErrMsg & TmpMsg
Else
ErrMsg = ErrMsg & "NomFichier et/ou Dossier non renseigné pour l'image :'" & !nomimage & "'"
End If
.MoveNext
Wend
.Close
End With
fin:
Set oRs = Nothing
Set oDb = Nothing
Set oExif = Nothing
Set oGps = Nothing
TmpMsg = i & " lignes de la table ont été mises à jour avec succès"
If Len(ErrMsg) > 0 Then
MsgBox "Des erreurs sont survenues, voir détails dans la fenêtre exécution", vbInformation, "MaJExifGpsTableImage()"
Debug.Print TmpMsg & vbCrLf & ErrMsg
Else
MsgBox "Mise à jour terminée sans erreur" & vbCrLf & TmpMsg, vbInformation, "MaJExifGpsTableImage()"
End If
Exit Function
MyErr:
MsgBox "Erreur grave n°" & Err.Number & vbCrLf & Err.Description, vbCritical, "MaJExifGpsTableImage()"
GoTo fin
End Function
Private Function setExifTableImage(ByRef Rs As DAO.Recordset, ByRef clEx As ClExif, ByVal TFichier As String) As String
' Variable pour donnée brute
Dim lData As Variant, f As String
' Gestion d'erreurs rapide
On Error Resume Next
' Ouverture du nouveau fichier
If Not clEx.OpenFile(TFichier) Then
setExifTableImage = "Erreur ouverture image : " & TFichier & " par oExif" & vbCrLf
Else
lData = clEx.GetExifData(TagMakerNote)
With Rs
' Taille de l'image
!taille = clEx.GetExifData(TagImageWidth) & " x " & clEx.GetExifData(TagImageHeight)
' Vitesse ISO
![Vitesse ISO] = Format(clEx.GetExifData(TagISOSpeedRatings), "\I\S\O 000")
' Modèle appareil
![Modèle appareil] = clEx.GetExifData(TagEquipModel)
' Fabricant
!fabricant = clEx.GetExifData(TagEquipMake)
' Version EXIF
![Version EXIF] = clEx.GetExifData(TagExifVersion)
' Description
'EImageDescription = clEx.GetExifData(TagImageDescription)
' Auteur
!auteur = clEx.GetExifData(TagArtist)
' Date du cliché
![Date cliché] = Format(clEx.GetExifData(TagDateTimeOriginal), "d mmmm yyyy" & vbCrLf & "hh:nn:ss")
' Miniature
'Me.Image0.Picture = ""
'Me.Image0.PictureData = clEx.GetExifData(TagThumbnailData)
' Temps exposition
' On stock d'abord le résultat dans lData
lData = clEx.GetExifData(TagExposureTime)
' On obtient un tableau de 2 valeurs
If Not IsNull(lData) Then
If lData(1) > lData(0) Then
' Temps inférieur à 1 secondes
![Temps exposition] = "1/" & Int(lData(1) / lData(0)) & " secondes"
Else
' Temps supérieur ou égal à 1 secondes
![Temps exposition] = Int(lData(0) / lData(1)) & " secondes"
End If
Else
![Temps exposition] = vbNullString
End If
' Point -F
lData = clEx.GetExifData(TagFNumber)
If Not IsNull(lData) Then
![Point-F] = Format(lData(0) / lData(1), "F0.0")
Else
![Point-F] = vbNullString
End If
' Flash
lData = clEx.GetExifData(TagFlash)
If Not IsNull(lData) Then
f = IIf(Mid(lData, 8, 1) = "1", "Flash déclenché", "Flash non déclenché")
f = f & vbCrLf & Switch(Mid(lData, 4, 2) = "00", "Mode inconnu", _
Mid(lData, 4, 2) = "01", "Flash forcé", _
Mid(lData, 4, 2) = "10", "Flash désactivé", _
Mid(lData, 4, 2) = "11", "Flash auto")
f = f & vbCrLf & Switch(Mid(lData, 2, 1) = "0", "Anti-Yeux rouges désactivé", _
Mid(lData, 2, 1) = "1", "Anti-Yeux rouges activé")
End If
!Flash = f
End With
End If
End Function
Private Function setGPSTableImage(ByRef Rs As DAO.Recordset, ByRef oGps As GPSExifReader, ByVal TFichier As String) As String
On Error GoTo MyErr
With oGps.OpenFile(TFichier)
Rs!GPSVersionID = .GPSVersionID
Rs!GPSLatitudeDecimal = .GPSLatitudeDecimal
Rs!GPSLongitudeDecimal = .GPSLongitudeDecimal
Rs!GPSAltitudeDecimal = .GPSAltitudeDecimal
End With
fin:
Exit Function
MyErr:
setGPSTableImage = "Erreur lecture image : " & TFichier & " par GPSExifReader" & vbCrLf
GoTo fin
End Function |
