XL 2019 Lire propriété (vidéo) à partir d'une boite de dialogue ?

re4

XLDnaute Occasionnel
Bonjour,
Il est encore temps de vous souhaiter une bonne et heureuse année.

J'ai adapté le code ci-dessous pour mes besoins, pouvez-vous m'aider pour aller chercher le fichier avec une boite de dialogue à la place de ce code :
Set objFolder = objShell.Namespace("D:\temp test\video")
Set objFolderItem = objFolder.ParseName("test.mp4")
Mon expérience VBA étant limitée, je n'ai peut -être pas utilisé les bons termes... :-(

Merci par avance
Bonne journée


VB:
Sub ProprieteVideo()

'Extraction de tous les codes sur le pc qui utilise ce fichier dans une feuille ""Code""
Call M2_code_champs1.code_champs1
    
'\
    Dim strHauteurVideo As String
    Dim strLargeurVideo As String
    Dim strHauteur As String
    Dim strLargeur As String
    Dim strTaille As String
    Dim strDebite As String
    
    Largeur = Worksheets("Code").Range("C2").Value  'Win 10 sur mon poste en 2022 => Code 316
    Hauteur = Worksheets("Code").Range("D2").Value 'win 10 sur mon poste en 2022 => Code 314
    Taille = Worksheets("Code").Range("E2").Value        'win 10 sur mon poste en 2022 => code 1
    Debit = Worksheets("Code").Range("F2").Value        'win 10 sur mon poste en 2022 => code 320
    
    Worksheets("Datas").Select
    Set objShell = CreateObject("shell.application")
    
    '***
    Set objFolder = objShell.Namespace("D:\temp test\video")
    Set objFolderItem = objFolder.ParseName("test.mp4")
    '***
    
    strLargeurVideo = objFolder.GetDetailsOf(objFolderItem, Largeur)
    strHauteurVideo = objFolder.GetDetailsOf(objFolderItem, Hauteur)
    Range("A1") = strLargeurVideo & "x" & strHauteurVideo
    strTaille = objFolder.GetDetailsOf(objFolderItem, Taille)
    Range("B1") = strTaille
      strDebit = objFolder.GetDetailsOf(objFolderItem, Debit)
    Range("C1") = strDebit
    
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing

End Sub
 

patricktoulon

XLDnaute Barbatruc
au puré
je suis loin de là moi 😂🤣
bon avançons
voici la version beta du dialog Responsive "GetIndicePropertyVideo"
le nom n'est pas définitif sachant que çà peu fonctionner sur d'autre extensions

mais là les index et noms ressortiront selon votre System exploitation
demo.gif
 

Pièces jointes

  • boite de dialogue selection de propriété fichier V° Beta Patricktoulon.xlsm
    26.2 KB · Affichages: 7
Dernière édition:

patricktoulon

XLDnaute Barbatruc
re
@Marcel32
oui je sais ce qu'il veut mais je ne travaille pas que pour lui
étant donné que nous avons pas les mêmes indexs et mêmes les noms divergent un peu
alors je commence par faire un dialog qui te propose les index et noms de properties selon le system d'exploit
là j'avance sur le fichier
patience ;)
 

TooFatBoy

XLDnaute Barbatruc
oui je sais ce qu'il veut mais je ne travaille pas que pour lui
OK.

Vu que chez moi, comme on le voit sur ma capture d'écran, ça ne sort aucune information intéressante sur le fichier vidéo, je ne vois pas l'intérêt qu'il pourrait y avoir de continuer à développer ce truc.

Mais comme tu le dis, tu travailles pour d'autres, alors peut-être qu'il y aura quelqu'un chez qui ça donnera des informations utiles. ;)
 

re4

XLDnaute Occasionnel
Merci à vous deux pour votre investissement, je pensais que Patrick le faisait pour le plaisir mais il dit qu'il y travaille, je n'ai pas encore négocié le taux horaire mais je crains que cela soit au dessus des moyens de l'assos... :) :)

En pièce jointe l'extraction sur mon PC avec le code du post #27, c'est exactement ce que je trouve avec ma macro.
Effectivement il manque quelques infos comme fait MédiaInfo mais pour se que je veux faire c'est largement suffisant.

Pour info ci-dessous le code que j'utilise, seule obligation il faut une image dans le répertoire (au-delà de 322 pour voir s'il y autre chose, j'ai même essayé 500) :
VB:
Sub code_champs1()

'Call M1_numerisation_image.Creer_image_test_jpg

Sheets("Code").Select
[a2:a400].ClearContents

    ActiveWorkbook.Worksheets("Code").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Code").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Code").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'nom de l'image
    NomImg = "Control_Code_Champ.jpg"

Dim det_Headers(336)
Set objShell = CreateObject("Shell.Application")
'Set objfolder = objShell.Namespace("C:\Users\Utilisateur\Pictures\test")
'Set objfolder = ThisWorkbook.Path & ("Control_Code_Champ.jpg")

    Set objFolder = objShell.Namespace(ThisWorkbook.Path & "\")

Workbooks(1).Sheets(1).Activate
For i = 1 To 336
det_Headers(i) = objFolder.GetDetailsOf(objFolder.Items, i - 1)
ActiveSheet.Cells(i + 2, 1) = det_Headers(i)
Next

      ActiveWorkbook.Worksheets("Code").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Code").AutoFilter.Sort.SortFields.Add2 Key:=Range( _
        "A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Code").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
End Sub
 

Pièces jointes

  • Codes (win 10 - ( 21H2 ).xlsx
    23 KB · Affichages: 4

re4

XLDnaute Occasionnel
@Marcel32
Juste pour info, sous quel os es-tu ? c'est bizarre avec ma macro ça fonctionnait sur toutes les versions à partir de Win 8 et même sous win 11, je pense que la macro de Patricktoulon dois marcher aussi puisque l'on trouve les mêmes résultats... les mystères de l'informatique ?
Mais si chez toi tu obtiens les informations dont tu as besoin, c'est le principal.👍
Oui reste à finaliser la macro, je ne pense pas y arriver sauf à passer des jours et encore... :-(

@patricktoulon
Super boulot, ça va en intéresser quelques uns, je vais le garder aussi.
Pour ce que je veux faire c'est surdimensionner, je reste sur ma 1er idée ça suffira pour l'instant, puisque dans mon fichier ce sera une infos parmi d'autres.
COMME AVEC CERTAINES (FONCTIONS/MEMBRE) DU SCRIPTINGFILESYSTEMOBJECT
LE LE SHELL.APPLICATION ATTEND UN VARIANT ET NON UN STRING
MÊME SI L'ARGUMENT EST UN STRING et c'est le cas pour le dossier
Pour moi c'est du chinois du futur ,-)

En tout cas merci à vous deux
 

TooFatBoy

XLDnaute Barbatruc
Juste pour info, sous quel os es-tu ? c'est bizarre avec ma macro ça fonctionnait sur toutes les versions à partir de Win 8 et même sous win 11, je pense que la macro de Patricktoulon dois marcher aussi puisque l'on trouve les mêmes résultats... les mystères de l'informatique ?
Je pense que le problème vient plus du type de fichier que de l'OS.
Je suis sous Windows 10 Pro 64 21H1 et Excel 2016.

[edit]
C'est confirmé : avec les mkv ça ne donne quasiment rien, et avec les mp4 c'est un peu moins mal puisque ça donne la définition X, la définition Y, mais hélas guère plus.
[/edit]



Pour moi c'est du chinois du futur ,-)
Il me semble que, en gros, il dit que quand tu utilises des instructions du genre CreateObject("shell.application") ou GetDetailsOf(objFolderItem, Largeur), il y a des formats de données à respecter pour appeler ces fonctions. Ici c'est une variable qui, bien qu'étant une chaîne de caractères (le nom du fichier), ne doit pas être au format "chaîne de caractères", mais au format "variant".

Un "variant" est une variable qui n'a pas de format défini, ça peut être un nombre, une date, une chaîne de caractères, ou autre. C'est une variable à géométrie variable... ;)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 025
Messages
2 084 749
Membres
102 652
dernier inscrit
Helpmeplz