Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 Combiner plusieurs macros en 1 seule fonction

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
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
 

Pièces jointes

  • InfoPC.xlsm
    35.2 KB · Affichages: 8
Dernière édition:
Trier par date Trier par votes

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Nicolas,
Sans toucher aux macros existantes, si on veut un résultat dans une feuille pour être exploitée plus tard, un essai en PJ.

NB : Les volumes disques remontés sont à priori en Go et non en Mo. Pouvez vous vérifier ?
 

Pièces jointes

  • Classeur3 V1.xlsm
    25 KB · Affichages: 4
Dernière édition:
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Pour moi le plus simple est de laisser tel que c'est : une macro pour chaque poste à renseigner.


J'ai un arrêt sur versionVBA = Application.VBE.version



Tes unités de mesure des capacités de mémoire (RAM ou HDD) sont fausses. Mais le vulgum pecus ne s'en rendra même pas compte puisqu'il verra la même chose dans son Windows.

Si tu veux donner certaines capacités en gigaoctets, il faut diviser par un milliard.
 
Dernière édition:
Vote positif 0 Vote négatif
C

crocrocro

XLDnaute Impliqué
Bonjour le fil,
mais pour moi le but était de simplifier au maximum si moyen et de pouvoir faire avec le résultat du debug.print un copier, pour que l'utilisateur n'est plus cas faire un coller ( copier, coller )
Cliquez pour agrandir...
une suggestion :
plutôt que d'écrire en debug.print :
en masquant l'affichage avec Application.ScreenUpdating :
- ajouter une feuille temporaire
- copier en a1, puis a2 ....
- exécuter la macro InfosDansPressePapier ci-dessous
- supprimer la feuille temporaire
VB: 
Public Function ClearPressePapier()
    With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
End Function
Public Property Let PressePapier(valeur)
    With CreateObject("htmlfile").parentwindow.clipboardData.setData("Text", valeur): End With
End Property
Public Property Get PressePapier()
    PressePapier = CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")
End Property
Sub InfosDansPressePapier()
Dim DerLigne As Integer
Dim TextePressePapier As String
    DerLigne = ActiveSheet.Cells.Find("*", , , , xlByRows, xlPrevious).Row 'de la feuille
    For i = 1 To DerLigne
        TextePressePapier = TextePressePapier & Cells(i, 1) & vbLf
    Next i
    MsgBox "Les informations système sont dans le Presse-papier.", vbInformation
    ClearPressePapier
    PressePapier = TextePressePapier  'se retrouve dans le pressePapier
End Sub
Je ne me souviens pas où j'ai pêché l'écriture dans le Presse-papier.
 
Vote positif 0 Vote négatif

jurassic pork

XLDnaute Occasionnel
Hello,
pour simplifier l'utilisation du WMI en VBA, j'ai "bricolé" une fonction.
VB: 
Function GetWMIData(qry) As Object
Cette fonction qui n'a pour paramètre que la requête WMI renvoie une collection de dictionnaires. Dans les dictionnaires il y a les propriétés de chaque élément de la collection. Pour simplifier, toutes les propriétés sont transformées en chaîne.
Voici le code de la fonction ainsi qu'une procédure de test de cette fonction :
VB: 
Function GetWMIData(qry) As Object
    ' J.P Octobre 2024
    Dim oWMI As Object, res As Object, Dict As Object
    Dim Item As Object, Props As Object, Prop As Object
    Dim Coll As New Collection
    Set oWMI = GetObject("winmgmts:root\CIMV2")
    Set res = oWMI.ExecQuery(qry)
    On Error Resume Next
    For Each Item In res
        Set Dict = CreateObject("Scripting.Dictionary")
        Set Props = Item.Properties_
        For Each Prop In Props
          Dict.Add Prop.Name, CStr(Prop.Value)
          'Debug.Print Prop.Name & ": " & CStr(Prop.Value)
        Next Prop
        Coll.Add Dict
    Next Item
    Set GetWMIData = Coll
    ' Nettoyage
    Set res = Nothing: Set oWMI = Nothing:
    Set Item = Nothing: Set Props = Nothing: Set Prop = Nothing:
End Function

Sub TestGetWMIData()
Dim res As Object, Dict As Object, Prop
   Set res = GetWMIData("SELECT * FROM Win32_OperatingSystem") ' Infos O.S
   For Each Dict In res
       For Each Prop In Dict.Keys
           Debug.Print Prop & ": " & Dict(Prop)
       Next
   Next
   Set res = Nothing
  ' Set res = GetWMIData("SELECT * FROM Win32_Process") ' Liste des processus
  ' For Each Dict In res
           ' Debug.Print Dict("Name") & ": " & Dict("ProcessId")
  ' Next
  ' Set res = Nothing
   Set res = GetWMIData("SELECT * FROM Win32_Processor")
   Debug.Print "Processeur: " & res(1)("Name") & _
               "Nombre de coeurs : " & res(1)("NumberOfCores")
   Set res = Nothing
   Set res = GetWMIData("SELECT TotalVisibleMemorySize, FreePhysicalMemory FROM Win32_OperatingSystem")
   Debug.Print "Mémoire totale (Ko): " & res(1)("TotalVisibleMemorySize")
   Debug.Print "Mémoire libre (Ko): " & res(1)("FreePhysicalMemory")
End Sub
On ne peut certainement pas faire toutes les requêtes avec cette fonction et il peut y avoir des bugs ou des améliorations à faire. En tout cas le Set res = Nothing que je fais dans la procédure de test m'a l'air de bien libérer tous les dictionnaires qui sont dans la collection.
Ne pas oublier qu'une requête WMI peut être lente (exemple pour lister les processus que j'ai mis en commentaire pour cette raison).
Ami calmant, J.P
 
Vote positif 0 Vote négatif

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Bonjour à tous,
Merci de vos retour,

A sylvanu, j'ai re-repris ton fichier et l'ai remodifié et allégé au maximum à ma sauce aussi , sans doute moyen de gratter des lignes encore, mais avec mes petites connaissances je ne saurai faire mieux .

A voir

VB: 
Option Explicit
Public Chaine$
Sub InfosPC()
    Dim Tablo, Taille%, i, Tablo2, Ligne%, Num%
    Chaine = ""
   
    GetWindowsInfo
    GetProcessorInfo
    GetRAMInfo
    GetGraphicsCardInfo
    GetExcelInfo
    GetDiskInfo

    [A2:B1000].Clear
   
    Application.ScreenUpdating = False

    Tablo = Split(Chaine, Chr(10))
    For i = 1 To UBound(Tablo)
        Tablo2 = Split(Tablo(i), ":")
            Range("A" & i + 1) = " " & Tablo2(0)
           
            If Left(Tablo2(0), 14) = "Informations d" Then Range("A" & i + 1).Font.Bold = True
            If Left(Tablo2(0), 9) = "Version w" Then Range("A" & i + 1).Font.Bold = True
            If Left(Tablo2(0), 9) = "Version e" Then Range("A" & i + 1).Font.Bold = True
           
            On Error Resume Next
            Range("B" & i + 1) = " " & Trim(Tablo2(1))
    Next i
    Columns("A:B").EntireColumn.AutoFit
    Columns("A:B").HorizontalAlignment = xlLeft
   
    Application.ScreenUpdating = True
End Sub

' 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")
 
    Chaine = Chaine & Chr(10) & "Informations du processeur"
    For Each objProcess In colProcess
        Chaine = Chaine & Chr(10) & "Nom du processeur: " & objProcess.Name
        Chaine = Chaine & Chr(10) & "Vitesse actuelle (MHz): " & objProcess.CurrentClockSpeed
        Chaine = Chaine & Chr(10) & "Nombre de cœurs: " & objProcess.NumberOfCores & Chr(10)
    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")

    Chaine = Chaine & Chr(10) & "Informations de mémoire"
    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)
     
        Chaine = Chaine & Chr(10) & "Mémoire totale (Go): " & totalMemoryGo
        Chaine = Chaine & Chr(10) & "Mémoire libre (Go): " & freeMemoryGo & Chr(10)
    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
    Chaine = Chaine & Chr(10) & "Informations de la carte graphique"
        Chaine = Chaine & Chr(10) & "Nom de la carte graphique : " & objItem.Name
        memory = objItem.AdapterRAM
        If IsNumeric(memory) And memory > 0 Then
            Chaine = Chaine & Chr(10) & "Mémoire vidéo : " & memory / 1024 / 1024 & " Mo" & Chr(10)  ' Convertir en Mo
        Else
            Chaine = Chaine & Chr(10) & "Mémoire vidéo : Information non disponible" & Chr(10)
        End If
    Next objItem
    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
 
    Chaine = Chaine & Chr(10) & "Version windows"
    Chaine = Chaine & Chr(10) & "Version : " & version
    Chaine = Chaine & Chr(10) & "Architecture : " & Architecture & Chr(10)
    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")

    Chaine = Chaine & Chr(10) & "Version excel & VBA"
    Chaine = Chaine & Chr(10) & "Version : " & versionAnnee & " (Build " & buildExcel & ")"
    Chaine = Chaine & Chr(10) & "Architecture : " & Architecture
    Chaine = Chaine & Chr(10) & "Version de VBA : " & versionVBA & Chr(10)
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")
 
    For Each objDisk In colDisks
        Chaine = Chaine & Chr(10) & "Informations du disque " & objDisk.DeviceID
        Chaine = Chaine & Chr(10) & "Type: " & objDisk.Description
        Chaine = Chaine & Chr(10) & "Espace libre (en Mo): " & Format(objDisk.FreeSpace / 1024 ^ 3, "0.00")
        Chaine = Chaine & Chr(10) & "Espace total (en Mo): " & Format(objDisk.Size / 1024 ^ 3, "0.00") & Chr(10)
    Next
    Set objWMI = Nothing
    Set colDisks = Nothing
End Sub
 

Pièces jointes

  • InfoPC2.xlsm
    29.7 KB · Affichages: 7
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Nicolas JACQUIN à dit:
Bonjour, c'est quoi que tu as comme version excel et vba ?
Cliquez pour agrandir...
Excel 2016.


Nicolas JACQUIN à dit:
re, les chiffres correspondent pourtant !!
Cliquez pour agrandir...
J'ai dit que ce sont les unités de mesure qui sont fausses, mais en fait ça revient au même : si tu laisses ces unités de mesure alors là oui les chiffres sont faux.
Mais comme je le disais plus haut, le vulgum pecus ne s'en rendra même pas compte puisqu'il verra la même chose dans son Windows.
 
Dernière édition:
Vote positif 0 Vote négatif

Nicolas JACQUIN

XLDnaute Impliqué
Supporter XLD
Re tout le monde, suite au message #10, j'ai mon copié directement , voici le code:

VB: 
Sub InfosPC()
    Dim Tablo, Taille%, i, Tablo2, Ligne%, Num%
    Dim DerniereLigne As Long
   
    Chaine = ""
   
    GetWindowsInfo
    GetProcessorInfo
    GetRAMInfo
    GetGraphicsCardInfo
    GetExcelInfo
    GetDiskInfo

    [A2:B1000].Clear
   
    Application.ScreenUpdating = False

    Tablo = Split(Chaine, Chr(10))
    For i = 1 To UBound(Tablo)
        Tablo2 = Split(Tablo(i), ":")
            Range("A" & i + 1) = " " & Tablo2(0)
           
            If Left(Tablo2(0), 14) = "Informations d" Then Range("A" & i + 1).Font.Bold = True
            If Left(Tablo2(0), 9) = "Version w" Then Range("A" & i + 1).Font.Bold = True
            If Left(Tablo2(0), 9) = "Version e" Then Range("A" & i + 1).Font.Bold = True
           
            On Error Resume Next
            Range("B" & i + 1) = " " & Trim(Tablo2(1))
    Next i
    Columns("A:B").EntireColumn.AutoFit
    Columns("A:B").HorizontalAlignment = xlLeft

    Application.CutCopyMode = False
    DerniereLigne = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A1:B" & DerniereLigne).Copy
   
    Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Question
XL 2021 Code manufacturier et fabricant (Ram) suite projet en cours ( à tester s'il vous plait )
2 3
Réponses
42
Affichages
1 K
TooFatBoy
  • Question
XL 2019 Cherche Volontaires pour tester dll interface VBA Dotnet
Réponses
8
Affichages
454
patricktoulon
Z
  • Résolu(e)
Microsoft 365 Modification du plusieurs fichiers excel en une seule fois
Réponses
3
Affichages
964
Zifox
Z
  • Question
création d'une fonction getobject améliorée
2 3
Réponses
35
Affichages
4 K
patricktoulon
P
  • Question
XL 2013 VBA - Enregistrer un fichier ouvert sur une autre instance Excel
Réponses
1
Affichages
3 K
bérylion
B
C
  • Question
XL 2013 Envoie groupé de mails contenant login et mdp uniques ... Mais pourquoi un espace en plus !?
Réponses
0
Affichages
864
Cecinerock
C
T
  • Question
XL 2010 En vba comment avoir "la main" sur une fenêtre externe comme une appli
Réponses
6
Affichages
4 K
tarvel
T
W
  • Question
XL 2010 compiler 2 macros en une seule
Réponses
9
Affichages
1 K
wenders frédéric
W
X
  • Question
Modifier paramètres imprimante NoiretBlanc ou Couleur
Réponses
2
Affichages
1 K
XceSs
X
J
  • Question
XL 2010 Séparer un fichier en plusieurs, en fonction de la valeur d'une colonne
Réponses
6
Affichages
1 K
Jaden
J
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…