XL 2021 Combiner plusieurs macros en 1 seule fonction

Nicolas JACQUIN · 28 Octobre 2024

Bonjour à tous,

Je me suis un peu amusé, parce que souvent on nous demande quel version d'excel ou windows on a et l'architecture,
J'ai plusieurs macros du coup, mais je voudrais savoir s'il serait possible de les cumuler en 1 seule fonction ou simplifier.

mes macros:

VB:

Option Explicit

' Fonction pour récupérer les informations du processeur
Sub GetProcessorInfo()
    Dim objWMI As Object
    Dim objProcessor As Object
    Dim colProcessors As Object
    Dim objProcess As Object
    Dim colProcess As Object
    Dim objWMIService As Object
 
    Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
    Set colProcess = objWMIService.ExecQuery("SELECT Name, CurrentClockSpeed, NumberOfCores FROM Win32_Processor")
 
    Debug.Print "=== Informations du processeur ==="
    For Each objProcess In colProcess
        Debug.Print "Nom du processeur: " & objProcess.Name
        Debug.Print "Vitesse actuelle (MHz): " & objProcess.CurrentClockSpeed
        Debug.Print "Nombre de cœurs: " & objProcess.NumberOfCores
        Debug.Print "-------------------------------"
        Debug.Print ""
    Next objProcess
End Sub

' Fonction pour récupérer la quantité de mémoire RAM
Sub GetRAMInfo()
    Dim objWMIService As Object
    Dim objWMI As Object
    Dim totalMemory As Double
    Dim colMem As Object
    Dim objMem As Object
 
    Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
    Set colMem = objWMIService.ExecQuery("SELECT TotalVisibleMemorySize, FreePhysicalMemory FROM Win32_OperatingSystem")

    Debug.Print "=== Informations de mémoire (Ram) ==="
    For Each objMem In colMem
        Dim totalMemoryGo As Double
        Dim freeMemoryGo As Double
 
        totalMemoryGo = Application.WorksheetFunction.Ceiling(objMem.TotalVisibleMemorySize / 1048576, 1)
        freeMemoryGo = Application.WorksheetFunction.Ceiling(objMem.FreePhysicalMemory / 1048576, 1)
 
        Debug.Print "Mémoire totale (Go): " & totalMemoryGo
        Debug.Print "Mémoire libre (Go): " & freeMemoryGo
        Debug.Print "-------------------------------"
        Debug.Print ""
    Next objMem
End Sub

' Fonction pour récupérer les informations de la carte graphique
Sub GetGraphicsCardInfo()
    Dim objWMI As Object
    Dim objItems As Object
    Dim objItem As Object
    Dim strComputer As String
    Dim memory As Variant
 
    strComputer = "."
    Set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set objItems = objWMI.ExecQuery("SELECT * FROM Win32_VideoController")
 
    For Each objItem In objItems
    Debug.Print "=== Informations de la carte graphique ==="
        Debug.Print "Nom de la carte graphique : " & objItem.Name
        memory = objItem.AdapterRAM
        If IsNumeric(memory) And memory > 0 Then
            Debug.Print "Mémoire vidéo : " & memory / 1024 / 1024 & " Mo"  ' Convertir en Mo
        Else
            Debug.Print "Mémoire vidéo : Information non disponible"
        End If
    Next objItem
        Debug.Print "-------------------------------"
    Debug.Print ""
 
    Set objItems = Nothing
    Set objWMI = Nothing
End Sub

' Fonction pour récupérer la version de Windows et son architecture
Sub GetWindowsInfo()
    Dim wmi As Object
    Dim os As Object
    Dim strComputer As String
    Dim Architecture As String
    Dim version As String
 
    strComputer = "."
    Set wmi = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Set os = wmi.ExecQuery("SELECT * FROM Win32_OperatingSystem").ItemIndex(0)
    version = os.Caption
 
    If Len(Environ("ProgramFiles(x86)")) > 0 Then
        Architecture = "64 bits"
    Else
        Architecture = "32 bits"
    End If
 
    Debug.Print "=== Version windows ==="
    Debug.Print "Version : " & version
    Debug.Print "Architecture : " & Architecture
    Debug.Print "-------------------------------"
    Debug.Print ""

    Set os = Nothing
    Set wmi = Nothing
End Sub

' Fonction pour récupérer la version d'Excel et son architecture
Sub GetExcelInfo()
    Dim versionExcel As String
    Dim versionVBA As String
    Dim versionAnnee As String
    Dim Architecture As String
    Dim buildExcel As String
    Dim versionWindows As String
 
    versionExcel = Application.version
    versionVBA = Application.VBE.version
    buildExcel = Application.Build

    Select Case versionExcel
        Case "16.0"
            versionAnnee = "Excel 2016, 2019 ou Office 365"
        Case "15.0"
            versionAnnee = "Excel 2013"
        Case "14.0"
            versionAnnee = "Excel 2010"
        Case "12.0"
            versionAnnee = "Excel 2007"
        Case "11.0"
            versionAnnee = "Excel 2003"
        Case Else
            versionAnnee = "Version inconnue ou non prise en charge"
    End Select

    #If Win64 Then
        Architecture = "64 bits"
    #Else
        Architecture = "32 bits"
    #End If

    versionWindows = Environ("OS") & " " & Environ("PROCESSOR_ARCHITECTURE") & _
                     " " & Environ("OSVERSION")

    Debug.Print "=== Version excel & VBA ==="
    Debug.Print versionAnnee
    Debug.Print "Version : " & versionExcel & " (Build " & buildExcel & ")"
    Debug.Print "Architecture : " & Architecture
    Debug.Print "Version de VBA : " & versionVBA
    Debug.Print "-------------------------------"
    Debug.Print ""
End Sub

' Fonction pour obtenir l'état des disques durs
Sub GetDiskInfo()
    Dim objWMI As Object
    Dim objDisk As Object
    Dim colDisks As Object
    Dim i As Integer
 
    Set objWMI = GetObject("winmgmts:\\.\root\CIMV2")
    Set colDisks = objWMI.ExecQuery("Select * from Win32_LogicalDisk")
 
    i = 1
    For Each objDisk In colDisks
        Debug.Print "=== Informations du disque(N°" & i & ") " & objDisk.DeviceID '& " ==="
        Debug.Print "Type: " & objDisk.description
        Debug.Print "Espace libre (en Go): " & Format(objDisk.FreeSpace / 1024 ^ 3, "0.00")
        Debug.Print "Espace total (en Go): " & Format(objDisk.Size / 1024 ^ 3, "0.00")
        Debug.Print "-------------------------------"
        Debug.Print ""
    i = i + 1
    Next
End Sub

La macro d'appel:

Code:

Sub ShowSystemInfo()
    GetWindowsInfo
    GetProcessorInfo
    GetGraphicsCardInfo
    GetRAMInfo
    GetExcelInfo
    GetDiskInfo
End Sub

Le résultat:

Code:

=== Version windows ===
Version : Microsoft Windows 10 Professionnel
Architecture : 64 bits
-------------------------------

=== Informations du processeur ===
Nom du processeur: Intel(R) Core(TM) i5-10400F CPU @ 2.90GHz
Vitesse actuelle (MHz): 2904
Nombre de cœurs: 6
-------------------------------

=== Informations de la carte graphique ===
Nom de la carte graphique : NVIDIA GeForce RTX 3070
Mémoire vidéo : Information non disponible
-------------------------------

=== Informations de mémoire ===
Mémoire totale (Go): 32
Mémoire libre (Go): 21
-------------------------------

=== Version excel & VBA ===
Excel 2016, 2019 ou Office 365
Version : 16.0 (Build 16327)
Architecture : 32 bits
Version de VBA : 7.01
-------------------------------

=== Informations du disque(N°1) C:
Type: Disque monté local
Espace libre (en Go): 468,63
Espace total (en Go): 930,91
-------------------------------

=== Informations du disque(N°2) D:
Type: Disque monté local
Espace libre (en Go): 220,17
Espace total (en Go): 465,76
-------------------------------

=== Informations du disque(N°3) E:
Type: Disque monté local
Espace libre (en Go): 318,42
Espace total (en Go): 931,51
-------------------------------

=== Informations du disque(N°4) F:
Type: Disque monté local
Espace libre (en Go): 734,11
Espace total (en Go): 931,51
-------------------------------

=== Informations du disque(N°5) I:
Type: Disque amovible
Espace libre (en Go):
Espace total (en Go):
-------------------------------

=== Informations du disque(N°6) K:
Type: Disque monté local
Espace libre (en Go): 884,38
Espace total (en Go): 931,51
-------------------------------

J'en profite au passage pour dire à Patrick que je salut, s'il passe par là, qu'il y a un petit soucis avec son indenter à ce niveau là

Merci à tous
Nicolas

Nicolas JACQUIN · 30 Octobre 2024

TooFatBoy à dit:
Il n'y en a peut-être pas 7, mais en tout cas j'espère que ce ne sont pas vraiment des erreurs...

À part l'espace libre qui a changé, c'est la même chose.

Et tu sais au moins à quel disque cela correspond, t'es gentil mais j'ai galéré

, petit niveau moi

TooFatBoy · 30 Octobre 2024

Nicolas JACQUIN à dit:
j'ai galéré

Je me doute, et c'est pour ça que j'adooore encore plus le résultat !

Nicolas JACQUIN · 30 Octobre 2024

TooFatBoy à dit:
Je me doute, et c'est pour ça que j'adooore encore plus le résultat !

Pour en revenir à ta première question, je sais pas si tu as testé, j'ai fouillé un peu, ma méthode à moi est une méthode binaire qui colle parfaitement.
Ta méthode à toi qui veut diviser par 1000000000, est une méthode décimale, mais on est loin du compte.

Je te laisse essayer :

VB:

Sub calcul()

'methode 1
octets1 = 506452115456# / (1024 ^ 3) 'ma méthode
Debug.Print Format(octets1, "0.00")

'methode 2
octets2 = 506452115456# / 1073741824 'une autre méthode
Debug.Print Format(octets2, "0.00")

'methode 3
Octets3 = 506452115456# / 1000000000 'ta méthode
Debug.Print Format(Octets3, "0.00")

End Sub

Nicolas JACQUIN · 30 Octobre 2024

Et même encore une autre, qui revient à la première

VB:

'methode 4
Octets4 = 506452115456# / 1024 / 1024 / 1024 '
Debug.Print Format(Octets4, "0.00")

Et je tombe exactement pareil aussi
Du coup je préfère rester sur ce que j'ai pondu et qui conviendra mieux

VB:

Sub calcul()

'methode 1
octets1 = 506452115456# / (1024 ^ 3) 'ma méthode
Debug.Print Format(octets1, "0.00")

'methode 2
octets2 = 506452115456# / 1073741824 'une autre méthode
Debug.Print Format(octets2, "0.00")

'methode 3
Octets3 = 506452115456# / 1000000000 'ta méthode
Debug.Print Format(Octets3, "0.00")

'methode 4
Octets4 = 506452115456# / 1024 / 1024 / 1024 'Une autre encore qui revient à la première
Debug.Print Format(Octets4, "0.00")

End Sub

TooFatBoy · 30 Octobre 2024

Non, je n'ai pas essayé, mais comme je t'ai dit si tu mets Go il faut diviser par 1 000 000 000.

Et en plus tu dis toi-même que tu utilises "une méthode binaire et non décimale".
Donc soit tu utilises "une méthode décimale" et une unité décimale, soit tu utilises "une méthode binaire" et une unité binaire. Mais pas un mélange des deux comme fait Microsoft qui compte des pouces et affiche des centimètres.

Nicolas JACQUIN à dit:
Du coup je préfère rester sur ce que j'ai pondu et qui conviendra mieux

Ça, j'en aurais mis ma main à couper !

Microsoft écrit des âneries, alors on écrit les mêmes âneries pour ne pas déranger le vulgum pecus...

Puisque tu as la gentillesse de donner ton code source, je corrigerais dans la version que je garderais sous le coude car parfaitement fonctionnelle.

Nicolas JACQUIN · 30 Octobre 2024

TooFatBoy à dit:
Ça, j'en aurais mis ma main à couper !

Je préfère avoir des valeurs cohérentes que des valeurs qui n'ont rien à voir avec la réalité, tu crois pas ?
Mais essai, tu verras bien

Nicolas JACQUIN · 30 Octobre 2024

Et ça c'est pas de moi

TooFatBoy · 30 Octobre 2024

Nicolas JACQUIN à dit:
Je préfère avoir des valeurs cohérentes que des valeurs qui n'ont rien à voir avec la réalité, tu crois pas ?

Ben oui, autant écrire n'importe quoi, c'est plus cohérent... Franchement, que crois-tu que j'en pense ?

C'est ton programme, donc tu fais ce que tu veux avec. Je voulais juste te signaler l'erreur, que tu viens de transformer en faute.

En tout cas, merci pour ton travail.
J'adooore !

TooFatBoy · 30 Octobre 2024

Nicolas JACQUIN à dit:
Et ça c'est pas de moi

Ce n'est peut-être pas de toi, mais c'est quand même une ânerie.

Nicolas JACQUIN · 30 Octobre 2024

TooFatBoy à dit:
Ce n'est peut-être pas de toi, mais c'est quand même une ânerie.

????

TooFatBoy · 30 Octobre 2024

Nicolas JACQUIN à dit:
????

Ah ben j'avais prévenu dès #7 : tu affiches quelque chose de faux, mais ça ne choque pas les non spécialistes.

TooFatBoy · 31 Octobre 2024

Nicolas JACQUIN à dit:
Je préfère avoir des valeurs cohérentes que des valeurs qui n'ont rien à voir avec la réalité, tu crois pas ?

Le problème c'est que tu fais l'inverse, camarade.

En fait ce sont tes valeurs qui ne correspondent pas à la réalité.

Pour preuve, quand tu as acheté ton SSD WD, il était annoncé pour 931,51 Go ou pour 1 To ?

Nicolas JACQUIN · 31 Octobre 2024

TooFatBoy à dit:
Le problème c'est que tu fais l'inverse, camarade.
En fait ce sont tes valeurs qui ne correspondent pas à la réalité.

Pour preuve, quand tu as acheté ton SSD WD, il était annoncé pour 931,51 Go ou pour 1 To ?

Oui j'avais bien compris la différence et ce que tu voulais dire, j'ai trouvé une astuce, tu seras content.

Nicolas JACQUIN · 31 Octobre 2024

Re mon Jacky, à ton choix du coup tu auras

Nicolas JACQUIN · 31 Octobre 2024

Bonjour à tous,
La version corrigée et rectifiée, dites-moi ce que vous en pensez.

Si vous voyez des choses à reprendre, je suis à l'écoute

Merci d'avance
Nicolas

XL 2021 Combiner plusieurs macros en 1 seule fonction

XLDnaute Impliqué

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

Discussions similaires

Partager cette page

Statistiques des forums