' ----------------------------------------------------------
' Script VBS d'affichage sous EXCEL de la liste des
' Permet d'afficher sur EXCEL la liste des groupes et
' comptes sur une machine locale ou distante
' ----------------------------------------------------------
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")
' ------------------------------- l'errer est just sur la ligne qui est en dessous----------------
Set GUset =GetObject("winmgmts:{impersonationLevel=impersonate}!//" &Computer).InstancesOf _
("Win32_GroupUser")
for each GU in GUset
setGroup=GetObject("winmgmts:" & GU.GroupComponent)
set User=GetObject("winmgmts:" & GU.PartComponent)
GName=Group.Name
Uname=User.Name
IfGDict.Exists(GName) Then
OldList=GDict.Item(GName)
GDict.Item(GName)=OldList& "," & UName
Else
GDict.AddGName, UName
EndIf
IfUDict.Exists(UName) Then
OldList=UDict.Item(UName)
UDict.Item(UName)=OldList& "," & GName
Else
UDict.AddUName, GName
EndIf
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
CelluleNL,2,GtabG(i),true,false,8
If nm>=0Then
Forj = 0 To nm
Ifj>0 Then NL=NL+1
CelluleNL,3,Members(j),false,false,8
Next
EndIf
ColorNLdeb,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
CelluleNL,5,UtabU(i),true,false,8
If ng>=0Then
Forj = 0 To ng
Ifj>0 Then NL=NL+1
CelluleNL,6,Groups(j),false,false,8
Next
EndIf
ColorNLdeb,5,NL,6,xlThin,LightTurquoise
Next
Color 3,5,NL,6,xlMedium,-2
If NL>NLmax Then NLMax=NL
Cellule NLMax+2,1,"",false,true,8
oXL.Columns("B:F").Select
oXL.Selection.Columns.AutoFit
oXL.Range("A1").Select
ExcelFile=getpath() & "Liste des comptes de "& Computer &".xls"
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
Ifcasse Then oXL.Selection.Font.Bold =True
Ifitalic Then oXL.Selection.Font.Italic =True
Ifsize<>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 Casecol
Case-1
IfIndexCol=1 Then
.ColorIndex= LightTurquoise
Else
.ColorIndex= LightYellow
EndIf
Case-2
Caseelse
.ColorIndex=col
EndSelect
.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
'--------------------------------------------------------------------
je n'y connai rien en vbscript c qu'il me faut ce script absolument pour mon taff.
ce script permet Permet d'afficher sur EXCEL la liste des groupes et
