none
Exifs, code des champs (propriété) incompatibles suivant la version de windows 10 RRS feed

  • Question

  • Bonjour,

    J'espère que je suis sur le bon forum, si non toutes mes excuses

    j'ai utilisé ce code avec succès jusqu'à maintenant.

    Visiblement Win10 n'utilise plus les mêmes codes de champs suivant la version...

    Exemple

    Code 168 pour largeur pixel devient 171 sur une autre machine !

    Code 171 pour hauteur pixel devient 173 sur une autre machine !

    Le programme devient donc incompatible, j'ai constaté que le code 31 (dimension => largeur x hauteur) n'a pas changé

    Est-il possible de modifier ce super code vba pour remplacer les 2 codes de champs précédent par le code 31 ?

    Dans ma feuille Excel la largeur pixel est en colonne D et la hauteur pixel en colonne E (ça ne change pas).

    Ci-dessous, une partie du code adapté à mon besoin avant le changement de code champs dans Win 10

     Arr = Array(0, 20, 1, 168, 171, 21) ' Win 10 => le 168, 171 à remplacer par le code 31
    Set objShell = CreateObject("Shell.Application")
    Set objfolder = objShell.Namespace(CStr(Répertoire))
    Application.ScreenUpdating = False
      Application.EnableEvents = False
    
    With ThisWorkbook
          With .Sheets("Extract") '<= Adapter le nom de la feuille
              .Activate
              'For Each Elt In Arr
              '    det_Headers(i) = objfolder.GetDetailsOf(objfolder.Items, Elt)
              '    .Cells(1, i + 1) = det_Headers(i)
               '   i = i + 1
              'Next
             
           j = 3: i = 0 'j=3 données en ligne 3, i0 = colonne A
           
            For Each strFilename In objfolder.Items
                  For Each Elt In Arr
                      Select Case Elt
    'Rentrer tous les numéros des champs qui ont une valeur numérique, supprime les Caractères
                       ' Case 162, 164  'pour les données numériques win7
                        'Case 167, 169  'pour les données numériques win 8
                        Case 168, 171 'pour les données numériques win 10 (à remplacer par le code 31)
               
                              X = objfolder.GetDetailsOf(strFilename, Elt)
                              If Not IsNumeric(Left(X, 1)) Then
                                 X = Right(X, Len(X) - 1)
                              End If
                              .Cells(j, i + 1).Value = Val(Replace(Trim(X), ",", "."))
                          Case Else
                              .Cells(j, i + 1).Value = Trim(objfolder.GetDetailsOf(strFilename, Elt))
                      
                      End Select
                      i = i + 1
                      If i = 5 Then i = 26
           
                  Next
                      j = j + 1: i = 0
              Next
               
          End With
          
      End With

    Le code 31 renvoie la définition horizontale x verticale (ex : 3000 x 2000)

    Infos : Windows 10, office 2010, office 2016
    Mon niveau VBA ne me permet pas de faire la modification.
    J'avais posté dans le fil d'origine mais il date de 2014, je me suis permis de faire un nouveau post
    Merci beaucoup pour votre aide

    mardi 24 octobre 2017 06:00