Option Compare Database

Private Sub Commande1_Click()
On Error GoTo Err_Commande1_Click

Dim SQL_Fichier As String
Dim SQL_EXIF As String
Dim x, y, chkExif As Integer
Dim NomFichier As String
Dim NA, NB, NN, NC As Variant
Dim EB As String
Dim DC As String
Dim Vitesse As String
Dim Diaph As String
Dim ISO As String
Dim Focale As String
Dim DatePDV As String
Dim HeurePDV As String
Dim Appareil As String
Dim Flash As String
SQL_EXIF = ""
SQL_Fichier = ""
Dim clex As New ClExif
'-------------------------------------
DoCmd.SetWarnings False
'-------------------------------------
'-------Initialisation des compteurs--------------------------------
x = 0
y = 0
NA = Nz(Me.NA, 0)
NB = Nz(Me.NB, 0)
'------------Précautions pour la boucle----------------------------------
    If NA > NB Then
        MsgBox "Le numéro de fin" & (Chr(13)) & "est supérieur au numéro de début !"
        GoTo FIN
    End If
NN = NA
NC = NB - NA
'-------------------------------------------------------------
If NA = 0 Or NB = 0 Then
    MsgBox "Préciser les numéros de début et de fin" & (Chr(13)) & "de la série d'images à modifier"
    GoTo FIN
End If
'HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
DEBUT:
Dim TFichier As String
'Dim GB, AB As String
'-----Initialisation des variables----------------------------------
TFichier = ""
ISO = ""
EB = ""
Appareil = ""
Focale = ""
Vitesse = ""
Diaph = ""
Flash = ""
 '-------------SQL pour l'ouverture des fichiers image--------------------------------------------------
' -------------où GB est le chemin et AB le nom du fichier stockés dans la base-----------   
SQL_Fichier = "SELECT GB & AB AS GBAB, Table_Base.Numero"
SQL_Fichier = SQL_Fichier & " FROM Table_Base"
SQL_Fichier = SQL_Fichier & " WHERE ((Table_Base.Numero)= " & NN & ")"
CurrentDb.QueryDefs("Requete_EXIF").SQL = SQL_Fichier
TFichier = Nz(DLookup("GBAB", "Requete_EXIF"), "")
'------------gestion des index annulés-------------------------------
    If TFichier = "" Then
        y = y + 1
        GoTo Suite
    Else
        'GoTo Suite

'HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH
'----------------séquence d'après Arkham----------------------------------------------------
'---------------les extractions sont stockées dans des variables------------------
'---------------qui sont ensuite exploitées dans une requete SQL--------------
' Variable pour donnée brute-------------------------------------------
    Dim lData As Variant
' Gestion d'erreurs rapide
    On Error Resume Next
' Ouverture du nouveau fichier
    clex.OpenFile TFichier

' Vitesse ISO--------------------------------------------------------
    
        ISO = Format(clex.GetExifData(clex.ISOSpeedRatings), "000") ' \A\S\A")

' Taille de l'image-------------------------------------------------------------

        EC = clex.GetExifData(clex.ImageWidth) & " x " & clex.GetExifData(clex.ImageHeight)
        If clex.GetExifData(clex.ImageWidth) > clex.GetExifData(clex.ImageHeight) Then
            EB = "Horizontal"
        Else
            EB = "Vertical"
        End If

' Modèle appareil--------------------------------------------------

    Appareil = clex.GetExifData(clex.EquipModel)

' FocalLength--------------------------------------------------

    Dim lDataB As Variant
    Dim lFocalLength As String
   ' On stocke  d'abord le résultat dans lDataB
    lDataB = clex.GetExifData(clex.FocalLength)
    ' On obtient un tableau de 2 valeurs
    If Not IsNull(lDataB) Then
        If lDataB(1) > lDataB(0) Then
            ' Inférieur à  1 mm (je sais pas si ça existe??)
            lFocalLength = "1/" & Int(lDataB(1) / lDataB(0)) ' & " mm"
        Else
            ' Supérieur ou égal à 1 mm
            lFocalLength = Int(lDataB(0) / lDataB(1)) ' & " mm"
        End If
    Else
        lFocalLength = ""
    End If
    Focale = lFocalLength

' ExposureIndex--------------------------------------------------
    'Dim lDataC As Variant
    'lDataC = clex.GetExifData(clex.ExposureIndex)
    'Debug.Print lDataC
    
    'EExposureIndex.Value = clex.GetExifData(clex.ExposureIndex)
    
' Date du cliché--------------------------------------------------
    
    DatePDV = Format(clex.GetExifData(clex.DateTimeOriginal), "dd mmmm yyyy") ' & "  -  " & "hh:nn:ss")

' Heure du cliché--------------------------------------------------
    
    HeurePDV = Format(clex.GetExifData(clex.DateTimeOriginal), "hh:nn")

' Temps exposition-------------------------------------------

    ' On stocke  d'abord le résultat dans lData
    lData = clex.GetExifData(clex.ExposureTime)
    ' On obtient un tableau de 2 valeurs
    If Not IsNull(lData) Then
        If lData(1) > lData(0) Then
            ' Temps inférieur à  1 secondes
            Vitesse = "1/" & Int(lData(1) / lData(0)) '& " s"
        Else
            ' Temps supérieur ou égal à 1 secondes
            Vitesse = Int(lData(0) / lData(1)) '& " secs"
        End If
    Else
        Vitesse = Null
    End If

' Point -F----------------------------------------------------

    lData = clex.GetExifData(clex.FNumber)
    If Not IsNull(lData) Then
        Diaph = Format(lData(0) / lData(1), "0.0")
    Else
        Diaph = Null
    End If

' Flash--------------------------------------------------------

    lData = clex.GetExifData(clex.Flash)
        If Not IsNull(lData) Then
            Flash = IIf(Mid(lData, 8, 1) = "1", "Flash", "Non")
            'EFlash.Value = EFlash.Value & 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")
            'EFlash.Value = EFlash.Value & vbCrLf & Switch(Mid(lData, 2, 1) = "0", "Anti-Yeux rouges désactivé", _
                                                  Mid(lData, 2, 1) = "1", "Anti-Yeux rouges activé")
            'EFlash.Value = "Oui"
        'Else
            'EFlash.Value = "Non"
        End If

'---------------------------------------------------------------------
    Set clex = Nothing
'-------------------fin de la séquence Arkham-------------------------------------------------
'HHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHHH

DoCmd.SetWarnings False
'------------------indicateur visuel supplémentaire (type check)----------------------------------
    If Appareil <> "" Then
        chkExif = -1
    Else
        chkExif = 0
    End If
'-----------Mise à jour SQL de la base------------------------------------------------
SQL_EXIF = "UPDATE Table_Base SET Table_Base.HeurePDV = " & Chr(34) & HeurePDV & Chr(34) & ", Table_Base.EB = " & Chr(34) & EB & Chr(34) & ", Table_Base.EC = " & Chr(34) & EC & Chr(34) & ", Table_Base.Exif = " & Chr(34) & chkExif & Chr(34) & ", Table_Base.ISO = " & Chr(34) & ISO & Chr(34) & ", Table_Base.Diaph = " & Chr(34) & Diaph & Chr(34) & ", Table_Base.Flash = " & Chr(34) & Flash & Chr(34) & ", Table_Base.Focale = " & Chr(34) & Focale & Chr(34) & ", Table_Base.Appareil = " & Chr(34) & Appareil & Chr(34) & ", Table_Base.DatePDV = " & Chr(34) & DatePDV & Chr(34) & ", Table_Base.Vitesse = " & Chr(34) & Vitesse & Chr(34) & " WHERE Table_Base.Numero =" & NN & ";"
DoCmd.RunSQL SQL_EXIF

Suite:
x = x + 1
'------------Détection de fin de boucle, message de confirmation et sortie du formulaire----------------------------------------------
If NN = NB Then
    Validation = MsgBox(x & " mise(s) à jour" & Chr(13) & "pour la série " & NA & "  à  " & NB & (Chr(13)) & (Chr(13)) & (NC - y + 1) & " tag(s) EXIF détecté(s) sur " & NC + 1 & (Chr(13)) & (Chr(13)) & "Il y a " & y & " numéro(s) non affecté(s)", 0, "Information")
    If Validation = vbOK Then
        DoCmd.Close acForm, "EXIF"
        DoCmd.OpenForm "Fiche_Saisie", acNormal, "", "", , acNormal
        DoCmd.SetWarnings True
    Else: GoTo FIN
    End If
Else
    NN = NN + 1
    GoTo DEBUT
End If
End If
'------------Cas particulier sans opération-----------------------------------------------
FIN:
If x = 0 Then
MsgBox ("Aucune modification n'a été effectuée...")
DoCmd.SetWarnings True
DoCmd.Close acForm, "ModifierSerie"
    DoCmd.OpenForm "Fiche_Saisie", acNormal, "", "", , acNormal
    End If
'-------------------------------------------------------------
Exit_Commande1_Click:
    Exit Sub

Err_Commande1_Click:
    MsgBox Err.Description
    Resume Exit_Commande1_Click
    
End Sub