1. #1
    re
    re est déconnecté
    Membre à l'essai
    Profil pro
    Inscrit en
    novembre 2005
    Messages
    38
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : novembre 2005
    Messages : 38
    Points : 16
    Points
    16

    Par défaut modifier code pour afficher le device id des claviers

    Bonjour,
    En partant de ce code (ou autre), est il possible de scanner que les concentrateur hub et les claviers, tout le reste ne m'est pas utile et prend du temps 15'' sur mon PC.
    Ce sera utilisé avec Excel 2010/32bits et win10

    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
    Sub usb_1()
    strComputer = "."
    [A1:B1048576].ClearContents
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colDevices = objWMIService.ExecQuery _
         ("Select * From Win32_USBControllerDevice")
     
    i = 1
    For Each objDevice In colDevices
       strDeviceName = objDevice.Dependent
       strQuotes = Chr(34)
       strDeviceName = Replace(strDeviceName, strQuotes, "")
       arrDeviceNames = Split(strDeviceName, "=")
       strDeviceName = arrDeviceNames(1)
       Set colUSBDevices = objWMIService.ExecQuery _
           ("Select * From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
       For Each objUSBDevice In colUSBDevices
          ' WScript.Echo objUSBDevice.Description
          ' WScript.Echo objUSBDevice.PnPDeviceID ' Changed from Description to PnPDeviceID
                                     'as this script can be altered to return any property
                                     'of the Win32_USBControllerDevice collection.
     
     
    Range(Cells(i, 1), Cells(i, 1)) = objUSBDevice.Description
    Range(Cells(i, 2), Cells(i, 2)) = objUSBDevice.PNPDeviceID
       i = i + 1
       Next
    Next
    End Sub
    Voici ce que je voudrais seulement :

    Concentrateur USB générique...........USB\VID_05E3&PID_0608\5&2A2B26F7&0&2...............'=>hub
    Concentrateur USB générique..........USB\VID_05E3&PID_0608\6&2E00BB6&0&4.....................'=>hub
    Périphérique d’entrée USB...............USB\VID_413C&PID_2106\7&22592B1F&0&3...................'=>clavier 1
    Périphérique clavier PIH..................HID\VID_413C&PID_2106\8&3663B53&0&0000...............'=>clavier 1
    Périphérique d’entrée USB...............USB\VID_413C&PID_2105\6&2E00BB6&0&2....................'=>clavier 2
    Périphérique clavier PIH...................HID\VID_413C&PID_2105\7&AF77C65&0&0000..............'=>clavier 2

    Merci
    Bonne journée

  2. #2
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    1 985
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 1 985
    Points : 4 513
    Points
    4 513

    Par défaut

    Peut-être avec le code modifié suivant, tu pourras y parvenir ?!
    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
    Dim arrDesc, j
    arrDesc = Array("Concentrateur USB générique", "Périphérique d’entrée USB", "Périphérique clavier PIH") ' Description des périphériques voulus
     
    Sub usb_1()
        strComputer = "."
        [A1:B1048576].ClearContents
        Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
        Set colDevices = objWMIService.ExecQuery _
             ("Select * From Win32_USBControllerDevice")
         dim Ret
        i = 1
        For Each objDevice In colDevices
           strDeviceName = objDevice.Dependent
           strQuotes = Chr(34)
           strDeviceName = Replace(strDeviceName, strQuotes, "")
           arrDeviceNames = Split(strDeviceName, "=")
           strDeviceName = arrDeviceNames(1)
           Set colUSBDevices = objWMIService.ExecQuery _
               ("Select * From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
           For Each objUSBDevice In colUSBDevices
              ' WScript.Echo objUSBDevice.Description
              ' WScript.Echo objUSBDevice.PnPDeviceID ' Changed from Description to PnPDeviceID
                                         'as this script can be altered to return any property
                                         'of the Win32_USBControllerDevice collection.
     
                For j = LBound(arrDesc) to UBound(arrDesc)
                   If objUSBDevice.Description = arrDesc(j) Then
                     Range(Cells(i, 1), Cells(i, 1)) = objUSBDevice.Description
                     Range(Cells(i, 2), Cells(i, 2)) = objUSBDevice.PNPDeviceID
                     i = i + 1
                     Exit For
                   End if
                Next ' j
           Next ' objUSBDevice
        Next    ' objDevice
    End Sub
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  3. #3
    re
    re est déconnecté
    Membre à l'essai
    Profil pro
    Inscrit en
    novembre 2005
    Messages
    38
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : novembre 2005
    Messages : 38
    Points : 16
    Points
    16

    Par défaut

    Bonjour,
    Merci pour ta reponse, oui ça fonctionne mais ça met 17" puisque ça scanne tout alors que le 1er code est presque instantané...

    D'autre part j'ai mis les deux 1er lignes sous Sub sinon code erreur, est-ce juste ? Comment résoudre le problème du scan pour plus de réactivité ?
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
     
    Sub usb_1()
    Dim arrDesc, j
    arrDesc = Array("Concentrateur USB générique", "Périphérique d’entrée USB", "Périphérique clavier PIH") ' Description des périphériques voulus

  4. #4
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    1 985
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 1 985
    Points : 4 513
    Points
    4 513

    Par défaut

    Bonjour;
    Les variables déclarées en dehors d'une fonction ou Sub (dans la déclaration générale) sont vues par celle-ci et toutes les autres, mais l'inverse est faux.
    Tu peux les mettre à l'intérieur de celle-ci sans problème.

    Pour la rapidité de retour de Sub_1(), je ne vois pas pour le moment un autre moyen qui y mène, puisque le code doit scanner tous les contrôleurs USB et choisir ceux qui nous intéressent.(On a 3 boucles imbriquées qui ralentissent la recherche).

    Peut-être que l'un des membres de ce forum aurait une idée sur ce sujet
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  5. #5
    Rédacteur/Modérateur
    Avatar de ProgElecT
    Homme Profil pro
    Retraité
    Inscrit en
    décembre 2004
    Messages
    3 999
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Communication - Médias

    Informations forums :
    Inscription : décembre 2004
    Messages : 3 999
    Points : 7 805
    Points
    7 805

    Par défaut

    Salut
    Citation Envoyé par l_autodidacte Voir le message
    Bonjour;........
    Peut-être que l'un des membres de ce forum aurait une idée sur ce sujet
    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
    Sub usb_1()
        arrDesc = Array("Concentrateur USB générique", "Périphérique d’entrée USB", "Périphérique clavier PIH") ' Description des périphériques voulus
        strComputer = "."
        strQuotes = Chr(34)
        '[A1:B1048576].ClearContents
        Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
        Set colDevices = objWMIService.ExecQuery _
             ("Select Dependent From Win32_USBControllerDevice")
        i = 1
        For Each objDevice In colDevices
           strDeviceName = (Split(Replace(objDevice.Dependent, strQuotes, ""), "="))(1)
           Set colUSBDevices = objWMIService.ExecQuery _
               ("Select Description, PNPDeviceID From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
           For Each objUSBDevice In colUSBDevices
              ' WScript.Echo objUSBDevice.Description
              ' WScript.Echo objUSBDevice.PnPDeviceID ' Changed from Description to PnPDeviceID
                                         'as this script can be altered to return any property
                                         'of the Win32_USBControllerDevice collection.
     
                For j = LBound(arrDesc) to UBound(arrDesc)
                   If objUSBDevice.Description = arrDesc(j) Then
                     'Range(Cells(i, 1), Cells(i, 1)) = objUSBDevice.Description
                     'Range(Cells(i, 2), Cells(i, 2)) = objUSBDevice.PNPDeviceID
                     'i = i + 1
                      List = List & "Description: "  & objUSBDevice.Description & vbnewline & "PNPDeviceID: "  & objUSBDevice.PNPDeviceID
                     Exit For
                   End if
                Next ' j
           Next ' objUSBDevice
        Next    ' objDevice
    msgbox list
    End Sub
    En jouant sur le retour de requêtes (Nombre de colonnes renvoyées) et la déclaration en une seule ligne (strDeviceName = ...), sur mon ordinateur, la boucle complète me réduit de moitié le temps.
    Pas sûr que sur tous les systèmes cela soit équivalant, mais apparemment il y a bien un gain de temps.

  6. #6
    Modérateur
    Avatar de l_autodidacte
    Homme Profil pro
    Retraité : Directeur de lycée/Professeur de sciences physiques
    Inscrit en
    juillet 2009
    Messages
    1 985
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : Tunisie

    Informations professionnelles :
    Activité : Retraité : Directeur de lycée/Professeur de sciences physiques
    Secteur : Enseignement

    Informations forums :
    Inscription : juillet 2009
    Messages : 1 985
    Points : 4 513
    Points
    4 513

    Par défaut

    Bien vu ProgElecT
    Crois-moi, en disant "Peut-être que l'un des membres de ce forum aurait une idée sur ce sujet", j'ai directement pensé à toi

    La rapidité vient du fait qu'on sélectionne directement les éléments dont on a besoin :Dependent, Description, PNPDeviceID

    Une autre amélioration de la rapidité est de sortir de la boucle For Each objUSBDevice In colUSBDevices juste après Next ' j.
    Pour visualiser le résultat, j'inscris le tout dans un fichier texte y compris la durée d'exécution de sub_1 ; voici le code retouché :
    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
    Sub usb_1()
        arrDesc = Array("Concentrateur USB générique", "Périphérique d’entrée USB", "Périphérique clavier PIH") ' Description des périphériques voulus
        strComputer = "."
        strQuotes = Chr(34)
        '[A1:B1048576].ClearContents
        Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
        Set colDevices = objWMIService.ExecQuery _
             ("Select Dependent From Win32_USBControllerDevice")
      '   i = 1
        For Each objDevice In colDevices
           strDeviceName = (Split(Replace(objDevice.Dependent, strQuotes, ""), "="))(1)
           Set colUSBDevices = objWMIService.ExecQuery _
               ("Select Description, PNPDeviceID From Win32_PnPEntity Where DeviceID = '" & strDeviceName & "'")
           For Each objUSBDevice In colUSBDevices
              ' WScript.Echo objUSBDevice.Description
              ' WScript.Echo objUSBDevice.PnPDeviceID ' Changed from Description to PnPDeviceID
                                         'as this script can be altered to return any property
                                         'of the Win32_USBControllerDevice collection.
     
                For j = LBound(arrDesc) to UBound(arrDesc)
                   If objUSBDevice.Description = arrDesc(j) Then
                     'Range(Cells(i, 1), Cells(i, 1)) = objUSBDevice.Description
                     'Range(Cells(i, 2), Cells(i, 2)) = objUSBDevice.PNPDeviceID
                     'i = i + 1
                      List = List & "Desc: "  & objUSBDevice.Description & vbTab & "PNPDeviceID: "  & objUSBDevice.PNPDeviceID & vbNewLine
                     Exit For
                   End if
                Next ' j
                Exit For ' C'est ici la modification pour un petit gain de temps: sur ma machine on passe de 6 sec à 2 sec
           Next ' objUSBDevice
        Next    ' objDevice
    f.Write list 
    End Sub
    dt0 = Now
    set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile("DvcID.txt", 2, True)
    usb_1
    dt1 = Now
    diff = DateDiff("s", dt0, dt1)
    f.write vbNewLine & "Durée : " & diff & " sec"
    f.Close
    Createobject("Wscript.shell").Run  "DvcID.txt", 1 , False
    Mais attention : à la première exécution, cela prend plus de temps qu'à la 2ème
    Ne pas oublier le tag si satisfait.
    Voter pour toute réponse satisfaisante avec pour encourager les intervenants.
    Toujours utiliser la clause Option Explicit(VBx, VBS ou VBA)
    Vous pouvez consulter mes contributions
    Consultez les différentes FAQs et les Cours/Tutoriels VB6/VBScript
    Ne pas oublier L'Aide VBScript et MSDN VB6 Fr

  7. #7
    re
    re est déconnecté
    Membre à l'essai
    Profil pro
    Inscrit en
    novembre 2005
    Messages
    38
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : novembre 2005
    Messages : 38
    Points : 16
    Points
    16

    Par défaut

    Bonjour,
    Un grand merci à vous deux pour vous être penchés sur mon p'tit problème ;-)
    Sur vos 2 codes j'ai l'erreur à cette ligne :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    strDeviceName = (Split(Replace(objDevice.Dependent, strQuotes, ""), "="))(1)
    Elle est rouge et message ''erreur de compilation'' au lancement de la macro, d'autre part n'étant pas spécialiste du VBA, est il normal que le End Sub ne soit pas à la fin du code ?
    Tu dis, "j'écris dans un fichier texte", c'est un fichier qui est enregistré ? ou ?
    Si le code s'exécute en 2'', je pense que c'est gérable, pour l'instant je ne sais encore s'il faut le lancer à chaque fois qu'un clavier fait une saisie et donc ''Enter'', l'on y va par étape...
    Petit rappel si important : Win10 / Excel 2010-32bits / VBA 7.0.1640

    Merci encore
    Bon WE

  8. #8
    Rédacteur/Modérateur
    Avatar de ProgElecT
    Homme Profil pro
    Retraité
    Inscrit en
    décembre 2004
    Messages
    3 999
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : France, Haute Savoie (Rhône Alpes)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Communication - Médias

    Informations forums :
    Inscription : décembre 2004
    Messages : 3 999
    Points : 7 805
    Points
    7 805

    Par défaut

    Salut

    Citation Envoyé par re Voir le message
    Bonjour,
    .........
    d'autre part n'étant pas spécialiste du VBA, est il normal que le End Sub ne soit pas à la fin du code ?
    ..............
    Petit rappel si important : Win10 / Excel 2010-32bits / VBA 7.0.1640

    Merci encore
    Bon WE
    Les erreurs que tu constates sont surement le fait que l'on t'a proposé un code pour VBScript qui diffère un peu du code d'une macro VBA.
    La ligne strDeviceName = (Split(Replace(objDevice.Dependent, strQuotes, ""), "="))(1) fonctionne aussi bien en VBScript que VB6 et antérieur.
    Essais >strDeviceName = Split(Replace(objDevice.Dependent, strQuotes, ""), "=")(1), pour VBA cela pourrait peut être passer sans erreur [ (et ) en moins].


    Si tu prends le code de l_autodidacte ,
    de la ligne 1 à 33 tu as une sub,
    de la ligne 34 à 42 tu à le programme principal qui appel la sub usb_1 à la ligne 37.

    Moi pour voir l'amélioration possible de la rapidité du code, je l'ai fait sous VB6 et antérieur, puis retranscrit en VBScript, c'est là que j'ai vue que le code prenait la moitié moins de temps d'exécution.

  9. #9
    re
    re est déconnecté
    Membre à l'essai
    Profil pro
    Inscrit en
    novembre 2005
    Messages
    38
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : novembre 2005
    Messages : 38
    Points : 16
    Points
    16

    Par défaut

    Ca fonctionne avec ceci :
    strDeviceName = (Split(Replace(objDevice.Dependent, strQuotes, ""), "=")(1))
    Il faut supprimer les lignes après End sub pour le VBA 7.0 (celui qui est avec Excel 2010)
    Le code s'execute en 5'' avec Exit For et 7'' sans Exit For
    Comme vous le savez Wscript et f.write ne sont pas utilisé par ce VBA mais par VBAsript

    Les 2 premiers périph s'affichent presque instantanément, c'est le hub externe et les 2 claviers que j'ai branché qui s'affichent après 5".

    Peut on dire que l'on veut scanner que les périphs HID\VID ou USB\VID ?
    Exemples :
    Périphérique d’entrée USB USB\VID_413C&PID_2105\7&18384972&0&4
    Périphérique clavier PIH HID\VID_413C&PID_2105\8&7EDBD78&0&0000

    Pour l'utilisation de ces infos je pense qu'il va falloir lancer la macro pour chaque appuie sur Enter de chaque clavier ce qui rallonge le traitement et va peut être créer des conflits si l'on appuie en même temps sur les claviers.
    Pour 5 claviers ça fait 25 secondes pour avoir un résultat, c'est long !
    Qu'en passez vous ? quelles autres solutions ?

    Merci

Discussions similaires

  1. [XL-2007] Code pour afficher des images externe
    Par apdf1 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 21/08/2013, 14h28
  2. Réponses: 5
    Dernier message: 20/03/2011, 12h56
  3. Code pour afficher des fichiers de syntaxe similaire
    Par Richard_Rahl dans le forum Langages de programmation
    Réponses: 2
    Dernier message: 24/10/2008, 11h09
  4. [VB.NET] code pour afficher apercu avant impression
    Par DonJR dans le forum Windows Forms
    Réponses: 1
    Dernier message: 14/07/2006, 20h54
  5. Réponses: 8
    Dernier message: 02/06/2006, 21h01

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo