Chers tous bonjour,
En cherchant sur internet à télécharger un script VBS qui permet de lister les groupes et les comptes sur une machine locale ou distante sur EXCEL, j’ai trouvé ce qui suit.
**********************************************
' ----------------------------------------------------------
' Script VBS d'affichage sous EXCEL de la liste des
' des groupes et comptes sur une machine locale ou distante
' Syntaxe:
' accountlist [<ordinateur>]
' <ordinateur> : nom de machine
' si absent : ordinateur local
'
' ----------------------------------------------------------
Dim net, computer, args, GUSet, Group, User, GDict, UDict, Members, Groups
' Constantes EXCEL
' ----------------
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlEdgeLeft = 7
Const xlEdgeTop = 8
Const xlEdgeBottom = 9
Const xlEdgeRight =10
Const xlContinous = 1
Const xlThin = 2
Const xlMedium =&HFFFFEFD6
Const xlThick = 4
Const xlDouble =&HFFFFEFE9
Const xlAutomatic =&HFFFFEFF7
Const xlInsideVertical = 11
Const xlInsideHorizontal = 12
Const xlNone =&HFFFFEFD2
Const xlUnderlineStyleNone =&HFFFFEFD2
Const xlCenter =&HFFFFEFF4
Const xlBottom =&HFFFFEFF5
Const xlContext =&HFFFFEC76
Const xlSolid = 1
Const msoFalse = 0
Const msoScaleFromTopLeft = 0
Const xlR1C1 =&HFFFFEFCA
' Couleurs EXCEL
' --------------
Black = 1
Brown = 53
OliveGreen = 52
DarkGreen = 51
DarkGreenBlue = 49
DarkBlue = 11
Indigo = 55
Grey80 = 56
DarkRed = 9
Orange = 46
LightBrown = 12
Green = 10
GreenBlue = 14
Blue = 5
GrayBlue = 47
Gray50 = 16
Red = 3
LightOrange = 45
LimeGreen = 43
MarineGreen = 50
WaterGreen = 42
LightBlue = 41
Violet = 13
Gray40 = 48
Pink = 7
Gold = 44
Yellow = 6
BrigthGreen = 4
Turquoise = 8
SkyBlue = 33
Plum = 54
Grey25 = 15
SalmonPink = 38
Brown = 40
LightYellow = 36
LightGreen = 35
LightTurquoise= 34
MediumBlue = 37
Lavender = 39
White = 2
Set net = Wscript.CreateObject("WScript.Network" )
Set fso = WScript.CreateObject("Scripting.FileSystemObject" )
Set args = Wscript.Arguments
If args.count=0 Then
computer=net.ComputerName
Else
computer=args(0)
End If
Set GDict = WScript.CreateObject("Scripting.Dictionary" )
Set UDict = WScript.CreateObject("Scripting.Dictionary" )
Set GUset = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Computer).InstancesOf _
("Win32_GroupUser" )
for each GU in GUset
set Group=GetObject("winmgmts:" & GU.GroupComponent)
set User=GetObject("winmgmts:" & GU.PartComponent)
GName=Group.Name
Uname=User.Name
If GDict.Exists(GName) Then
OldList=GDict.Item(GName)
GDict.Item(GName)=OldList & "," & UName
Else
GDict.Add GName, UName
End If
If UDict.Exists(UName) Then
OldList=UDict.Item(UName)
UDict.Item(UName)=OldList & "," & GName
Else
UDict.Add UName, GName
End If
next
Dim GTabG,GtabU, UTabU, UTabG
GtabG=GDict.Keys
GtabU=GDict.Items
UtabU=UDict.Keys
UtabG=UDict.Items
Set oXL = WScript.CreateObject("EXCEL.application" )
oXL.Visible = True
oXL.Workbooks.Add
Cellule 1,1,"Liste des Groupes et Comptes de l'ordinateur " & Computer & " le " & FormatDateTime(now, vbLongDate),true,false,12
NL=3
Cellule NL,2,"GROUPE",true,false,10
Cellule NL,3,"COMPTES DU GROUPE",true,false,10
Color NL,2,NL,3,xlMedium,Grey25
IndexCol=1
For i = 0 To GDict.count-1
Members=Split(GtabU(i),"," )
nm=Ubound(Members)
NL=NL+1
NLdeb=NL
Cellule NL,2,GtabG(i),true,false,8
If nm>=0 Then
For j = 0 To nm
If j>0 Then NL=NL+1
Cellule NL,3,Members(j),false,false,8
Next
End If
Color NLdeb,2,NL,3,xlThin,LightTurquoise
Next
Color 3,2,NL,3,xlMedium,-2
NLMax=NL
NL=3
Cellule NL,5,"COMPTE",true,false,10
Cellule NL,6,"APPARTENANCE",true,false,10
Color NL,5,NL,6,xlMedium,Grey25
IndexCol=1
For i = 0 To UDict.count-1
Groups=Split(UtabG(i),"," )
ng=Ubound(Groups)
NL=NL+1
NLdeb=NL
Cellule NL,5,UtabU(i),true,false,8
If ng>=0 Then
For j = 0 To ng
If j>0 Then NL=NL+1
Cellule NL,6,Groups(j),false,false,8
Next
End If
Color NLdeb,5,NL,6,xlThin,LightTurquoise
Next
Color 3,5,NL,6,xlMedium,-2
If NL>NLmax Then NLMax=NL
Cellule NLMax+2,1,"JCB © 2004",false,true,8
oXL.Columns("B:F" ).Select
oXL.Selection.Columns.AutoFit
oXL.Range("A1" ).Select
ExcelFile=getpath() & "Liste des comptes de " & Computer &".xlsx"
If fso.FileExists(ExcelFile) Then fso.DeleteFile ExcelFile, true
oXL.ActiveWorkbook.SaveAs ExcelFile
oXL.ACtiveWorkbook.Saved = True
Wscript.quit
'--------------------------------------------------------------------
Sub Cellule(NumL,NumC,chaine,casse,italic,size)
oXL.Cells(NumL,NumC).Value = Chaine
If casse or size<>0 Then
Coords=CellName(NumL,NumC)
oXL.Range(Coords & ":" & Coords).Select
If casse Then oXL.Selection.Font.Bold = True
If italic Then oXL.Selection.Font.Italic = True
If size<>0 Then oXL.Selection.Font.Size = size
End If
End Sub
'--------------------------------------------------------------------
Function CellName(NumL,NumC)
If NumC<=26 Then
anumc=chr(64+NumC)
Else
n1=int(NumC/26)
n2=NumC-n1*26
anumc=chr(64+n1) & chr(64+n2)
End If
CellName=anumc & NumL
End Function
'--------------------------------------------------------------------
Sub Color(NLdeb,NCdeb,NLfin,NCfin,W,col)
Coords1=CellName(NLdeb,NCdeb)
Coords2=CellName(NLfin,NCfin)
oXL.Range(Coords1 & ":" & Coords2).Select
With oXL.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = W
.ColorIndex = xlAutomatic
End With
With oXL.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = W
.ColorIndex = xlAutomatic
End With
With oXL.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = W
.ColorIndex = xlAutomatic
End With
With oXL.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = W
.ColorIndex = xlAutomatic
End With
With oXL.Selection.Interior
Select Case col
Case -1
If IndexCol=1 Then
.ColorIndex = LightTurquoise
Else
.ColorIndex = LightYellow
End If
Case -2
Case else
.ColorIndex =col
End Select
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
IndexCol=3-IndexCol
End Sub
'--------------------------------------------------------------------
' Fonction de récupération du répertoire courant
Function GetPath()
Dim path
path = WScript.ScriptFullName
GetPath = Left(path, InStrRev(path, "\" ))
End Function
'--------------------------------------------------------------------
*****************************************************
Ceci dit, le script fonctionne correctement sur Win XP mais pas sur win7.
Etant donné que mon parc machine est sous 7, merci de m’aider à changer le dit Script.
Merci d'avance
---------------
HC
