simplifier un code

Version imprimable

simplifier un code

Bonjour a tous
je me demande si il n'y a pas un moyen de simplifier ce code
j'entends par la supprimer le besoins des 2 boucles imbriquées

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub WMI()
    Dim oWMISrvEx As Object    'SWbemServicesEx
    Dim oWMIObjSet As Object    'SWbemServicesObjectSet
    Dim oWMIObjEx As Object    'SWbemObjectEx
    Dim oWMIProp As Object    'SWbemProperty
    Dim sWQL As String    'WQL Statement
    Dim n As Long             'Generic Counter
    sWQL = "Select * From Win32_VideoController" ' classe utilisée
    Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
    Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
    For Each oWMIObjEx In oWMIObjSet
        For Each oWMIProp In oWMIObjEx.Properties_
            If oWMIProp.Name = "CurrentHorizontalResolution" Then Debug.Print "resolution horizontale " & oWMIProp.Value
            If oWMIProp.Name = "CurrentVerticalResolution" Then Debug.Print "resolution vertcale " & oWMIProp.Value
        Next
    Next
End Sub

1 pièce(s) jointe(s)

bonjour,

Pièce jointe 274887

je te propose cette modif qui liste toutes les properties

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
Sub v2WMI()
    Dim oWMISrvEx As Object    'SWbemServicesEx
    Dim oWMIObjSet As Object    'SWbemServicesObjectSet
    Dim oWMIObjEx As Object    'SWbemObjectEx
    Dim oWMIProp As Object    'SWbemProperty
    Dim sWQL As String    'WQL Statement
    Dim n As Long             'Generic Counter
    sWQL = "Select * From Win32_VideoController" ' classe utilisée
    Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
    Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
    For Each oWMIObjEx In oWMIObjSet
        For Each oWMIProp In oWMIObjEx.Properties_
            'Debug.Print oWMIProp.Name & " " & oWMIProp.Value
            msg = msg & oWMIProp.Name & " " & oWMIProp.Value & vbCrLf
        Next
    Next
    MsgBox msg
End Sub

@+JP

12/05/2017, 18h49
patricktoulon

re

bonjour et merci pour le retour

en fait je la connais cette macro mais je m'intéresse a faire sauter les boucles qui me sont inutile car le connais déjà les deux propriétés
12/05/2017, 19h10
unparia

Bonour à tous
Le VRAI problème est que WMI n'est pas FORCEMENT disponible sur toutes les machines et/ou OS.
Etre dépendant de sa disponibilité, n'est alors pas mieux que de l'être de l'utilisation de fonctions de l'Api de Windows.
Et c'est donc kif-kif !
Ta demande ne précise pas en quelles unités tu veux que soit exprimées ces dimensions. Si cela importe peu -->> pas de problème --->> facile de les avoir en points.

bonjour,

cette modif affiche : 3840

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub v3WMI()
    Dim oWMISrvEx As Object    'SWbemServicesEx
    Dim oWMIObjSet As Object    'SWbemServicesObjectSet
    Dim oWMIObjEx As Object    'SWbemObjectEx
    Dim oWMIProp As Object    'SWbemProperty
    Dim sWQL As String    'WQL Statement
    Dim n As Long             'Generic Counter
    sWQL = "Select * From Win32_VideoController" ' classe utilisée
    Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
    Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
    For Each oWMIObjEx In oWMIObjSet
    msg = oWMIObjEx.CurrentHorizontalResolution
    Next
    MsgBox msg
End Sub

@+JP

12/05/2017, 19h23
patricktoulon

re

bon ben c'est déjà bien une boucle en moins
12/05/2017, 19h26
mjpmjp

bonjour,

tu peux énumérer dans un tableau...
Tab(1)=oWMIObjEx.CurrentHorizontalResolution
Tab(2)=oWMIObjEx.CurrentVerticalResolution

@+JP
12/05/2017, 19h31
patricktoulon
@unparia
oui je sais j'explore toutes les possibilités

@mjpmjp
oui mais comme apres test il y a qu'un seul oWMIObjEx dans oWMIObjSet

j'aurais voulu remplacer
Code:

1 2 3 For Each oWMIObjEx In oWMIObjSet msg = oWMIObjEx.CurrentHorizontalResolution Next
par un truc du genre

Code:

WMIObjSet.item(1).CurrentHorizontalResolution
12/05/2017, 19h55
unparia

Je sais/devine ce que cache en réalité ta démarche -->>
Tu cherches à faire en VBA/Excel ce que VBA/Word fait assez parfaitement avec sa méthode Global.PointsToPixels, méthode
Histoire de déterminer la conversion de points en pixels, n'est-ce pas ?
12/05/2017, 19h59
Marc-L

Bonjour !

Citation:

Envoyé par unparia

Histoire de déterminer la conversion de points en pixels, n'est-ce pas ?

Même en VBA Excel ce n'est pas compliqué une fois la définition d'un point bien comprise,
s'agissant toujours de relativiser avec le dpi de la résolution (nombre de pixels par pouce) …

1 pièce(s) jointe(s)

bonjour,

Pièce jointe 274911

pourquoi erreur ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub v4WMI()
    Dim oWMISrvEx As Object    'SWbemServicesEx
    Dim oWMIObjSet As Object    'SWbemServicesObjectSet
    Dim oWMIObjEx As Object    'SWbemObjectEx
    Dim oWMIProp As Object    'SWbemProperty
    Dim sWQL As String    'WQL Statement
    Dim n As Long             'Generic Counter
 
 
    sWQL = "Select * From Win32_VideoController" ' classe utilisée
    Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
    Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
 
    MsgBox oWMIObjSet.Item(1).Properties_.Item(1).Name
End Sub

@+JP

12/05/2017, 20h21
patricktoulon

Citation:

Envoyé par unparia

Je sais/devine ce que cache en réalité ta démarche -->>
Tu cherches à faire en VBA/Excel ce que VBA/Word fait assez parfaitement avec sa méthode Global.PointsToPixels, méthode
Histoire de déterminer la conversion de points en pixels, n'est-ce pas ?

oui le but de la prolongation de l'autre discution c'est exactement ca
arriver a faire sans les api

tu viens de donner une piste
et si je créais un doc word juste pour ca :ptdr:

@mjpmjp
et oui!!!!!! c'est ca le soucis que je pige pas

bonjour,

j'ai vu ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
Function myCollection() As Object
     Set myCollection = New Collection
     myCollection.Add Item:=Range("A1").Cells, key:="a"
     myCollection.Add Item:=Range("B1").Cells, key:="b"
 End Function
 
 Sub foo()
     Dim xVal As Collection
     Set xVal = myCollection()
     MsgBox xVal("a").Address
 End Sub

pour Collection... j'arrive à rien

@+JP

12/05/2017, 20h34
patricktoulon

Citation:

Envoyé par Marc-L

Bonjour !
Même en VBA Excel ce n'est pas compliqué une fois la définition d'un point bien comprise,
s'agissant toujours de relativiser avec le dpi de la résolution (nombre de pixels par pouce) …

marc oui mais le but étant de trouver le dpi sans api ou l'operande obtenu par le calcul avec les api

@mjpmjp une revision sur la portée des variables et la transmision de variable et les fonctions qui deviennent variables et l'object collection s'impose
déjà on a un soucis ici
tu ne peut pas dimer une variable en tant que collection et dire ensuite que cette variable est unefonction instanciée en tant qu'Object devenant une collection
mais ca n'a aucun intérêt dans cet exercice

bonjour patricktoulon,

seul Item... ne fonctionne pas...
Code:

1 2 3 4 5 6 7 8 9 MsgBox oWMIObjSet.Count MsgBox oWMIObjSet.Security_.AuthenticationLevel MsgBox oWMIObjSet.Security_.Privileges.Count 'erreur....Item... MsgBox oWMIObjSet.Item(1).Properties_.Item(1).Count
le code "collection" n'est pas de moi...
l'idée était que on travaille sur des collections ...enfin je crois (disait la grenouille :ptdr:)

j'ai essayé item1, item alt255 1,...
pas possible de passer

@+JP

13/05/2017, 10h44
patricktoulon

re

re
Bonjour mjpmjp
oui moi aussi j'avais essaiyé et rien quedal walou walou
ca n'est peut être pas possible sur cet object
15/05/2017, 13h17
mercatog
@Patrick
Pour supprimer la seconde boucle il suffit de s'adresser directement à la propriété voulue (et par son nom)
Code:

1 2 3 4 '.... For Each oWMIObjEx In oWMIObjSet MsgBox oWMIObjEx.Properties_("CurrentHorizontalResolution").Value Next
@Patrick, bis

Tu peux même économiser ta requête

Code:

sWQL = "SELECT CurrentHorizontalResolution,CurrentVerticalResolution FROM Win32_VideoController"

2 pièce(s) jointe(s)

bonjour,

je reviens à la charge,

avec ce code je ne passe pas la "barrière" de "Item 1"

Code:

1
2
3
4
5
6
7
8
9
10
 
Sub v7WMI()
    sWQL = "Select * From Win32_VideoController" ' classe utilisée
    Set oWMISrvEx = GetObject("winmgmts:root/CIMV2")
    'Set oWMIObjGet = oWMISrvEx.get()
    Set oWMIObjSet = oWMISrvEx.ExecQuery(sWQL)
 
    'affiche 0
    Debug.Print oWMIObjSet.Security_.Privileges.Count    
End Sub

MAIS avec ce code OUI, MAIS...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub v8WMI()
    strComputer = "."
    strNameSpace = "root\CIMV2"
    strClass = "Win32_VideoController"
    strDisplayName = "WINMGMTS:{authenticationLevel=pktPrivacy,impersonationLevel=impersonate}"
 
    'Set objClass = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\" & strNameSpace & ":" & strClass)
    'Set objClass = GetObject(strDisplayName & "!\\" & strComputer & "\" & strNameSpace & ":" & strClass)
    Set objClass = GetObject("winmgmts:" & strNameSpace & ":" & strClass)
 
    'affiche la liste mais pas les valeurs (= Null)
    'For Each objClassProperty In objClass.Properties_
    '    Debug.Print objClassProperty.Name & " = " & objClassProperty.Value
    'Next
 
    'affiche 59
    Debug.Print objClass.Properties_.Count
    'affiche Null
    Debug.Print objClass.Properties_("Caption").Value 'item7
End Sub

MAIS la "Value" est Null (pour tous !!)
Pièce jointe 275566
alors que avec le premier code
Pièce jointe 275569

je viens de voir que "Local" est False ...
@+JP

15/05/2017, 14h24
patricktoulon

re

Bonjour mjpmjp
oui j'avais déjà testé

je crois qu'il n'est pas possible sans énumération par itération dans une boucle
j'apprécie le travail de recherche que tu fait:ccool: