Discussion :

[nikkss]

Bonjour le forum,

Je cherche désespérément depuis plusieurs jours le moyen d'afficher un popup pendant l'exécution de mon script.
J'ai trouvé qqes petits bouts de code qui permettent d'afficher le message pendant un laps de temps déterminé mais pas pendant toute l'exécution de mon script.
J'ai des commandes de copies de fichiers très lourds, donc le temps d'attente peut se compter en heure.

Avez-vous une idée?
Pour info voici mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Dim objFileSystemObject, fsO, FL, FD, strFolderPath, oFSO, oFld 
Dim oShell, oExec, sK, ScriptPath
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
strFolderPath = "F:\CopyTool"
 
If Not objFileSystemObject.FolderExists(strFolderPath) Then
	msgBox("Vérifiez que le lecteur USB3.0 est bien référencé en lecteur réseau F:\, ou bien vérifiez qu'il existe bien un répertoire CopyTool sur le disque de données.")
Else 
	Set FD = fso.GetFolder("F:\CopyTool\Database")
	FD.Name="Data"
End If
Set fso = Nothing
Set FD = Nothing
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
path = "C:\bvsys\TurnoutView3.7.2\Parameter\Directories.var"
content = fso.OpenTextFile(path,1).ReadAll
With New RegExp 
        .Global = True
        .Pattern = "W:\\SIM09\\[^\\]+"
        srepl = .Replace(content, GetRef("repl"))
End With 
fso.CreateTextFile(path,True).Write srepl
 
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
strFolderPath = "W:\SIM09\" & Date
 
CreateFullPath = False
If Not objFileSystemObject.FolderExists(strFolderPath) Then
	Set fs = CreateObject("Scripting.FileSystemObject") 
	fs.CreateFolder (strFolderPath)
	    'msgbox("Dossier Date créé")
        If Err.number <> 0 Then
           CreateFullPath = False ' Error while creating
           Call Err.Clear()
        End If
        On Error Goto 0
Else
   CreateFullPath = True
   'msgbox("Le dossier Date existe déjà")
End If
 
Set objFileSystemObject = Nothing
 
Set oFSO = CreateObject("Scripting.FileSystemObject") 
Set oCrFld= CreateObject("Scripting.FileSystemObject")
 
set oFld = oFSO.GetFolder("F:\CopyTool\Data") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\Data")
oFld.Copy "W:\SIM09\" & Date & "\Data",True
set oFld = oFSO.GetFolder("F:\CopyTool\RawData") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\RawData")
oFld.Copy "W:\SIM09\" & Date & "\RawData",True
set oFld = oFSO.GetFolder("F:\Zoes") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\Zoes")
oFld.Copy "W:\SIM09\" & Date & "\Zoes",True
 
WScript.Quit
 
Function FolderExists(strFolderPath)
    Dim fileObject
 
    Set fileObject = CreateObject("Scripting.FileSystemObject")
 
    On Error Resume Next ' Si erreur, continuer
    FolderExists     = fileObject.FolderExists(strFolderPath)
    If Err.number <> 0 Then
        FolderExists = False
        Call Err.Clear()
    End If
    On Error Goto 0
    Set fileObject = Nothing
End Function
 
Function repl(m,p,s)
    repl =  "W:\SIM09\" & Date 
End Function

D'avance merci pour votre aide.

[nikkss]

Bon j'ai finalement trouvé un petit bout de code me permettant de faire qqchose.

Résolu, et bonne journée à tous!

[hackoofr]

Bon j'ai finalement trouvé un petit bout de code me permettant de faire qqchose.
Résolu, et bonne journée à tous!

Tu sais que tu peux partager ta solution avec nous, ça peut aider d'autres personnes

[nikkss]

Bien sûr,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Set oSh=CreateObject("WScript.Shell")
If WScript.Arguments.Count = 1 Then
If WScript.Arguments(0) = "popup" Then
While True
oSh.Popup "Copie en cours, patientez..."
Wend
End If
End If
 
Set oExec=oSh.Exec ("WScript " & WScript.ScriptFullName & " popup")

[nikkss]

Parc contre, j'ai un message d'erreur à la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

oExec.Terminate

Dans mon code global:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Dim objFileSystemObject, fsO, FL, FD, strFolderPath, oFSO, oFld 
Dim oSh, oExec, sK, ScriptPath
 
Set oSh=CreateObject("WScript.Shell")
If WScript.Arguments.Count = 1 Then
If WScript.Arguments(0) = "popup" Then
While True
oSh.Popup "Copie en cours, patientez..."
Wend
End If
End If
 
Set oExec=oSh.Exec ("WScript " & WScript.ScriptFullName & " popup")
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
strFolderPath = "F:\CopyTool"
 
If Not objFileSystemObject.FolderExists(strFolderPath) Then
	msgBox("Vérifiez que le lecteur USB3.0 est bien référencé en lecteur réseau F:\, ou bien vérifiez qu'il existe bien un répertoire CopyTool sur le disque de données.")
Else 
	Set FD = fso.GetFolder("F:\CopyTool\Database")
	FD.Name="Data"
End If
Set fso = Nothing
Set FD = Nothing
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
path = "C:\bvsys\TurnoutView3.7.2\Parameter\Directories.var"
content = fso.OpenTextFile(path,1).ReadAll
With New RegExp 
        .Global = True
        .Pattern = "W:\\SIM09\\[^\\]+"
        srepl = .Replace(content, GetRef("repl"))
End With 
fso.CreateTextFile(path,True).Write srepl
 
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
strFolderPath = "W:\SIM09\" & Date
 
CreateFullPath = False
If Not objFileSystemObject.FolderExists(strFolderPath) Then
	Set fs = CreateObject("Scripting.FileSystemObject") 
	fs.CreateFolder (strFolderPath)
	    'msgbox("Dossier Date créé")
        If Err.number <> 0 Then
           CreateFullPath = False ' Error while creating
           Call Err.Clear()
        End If
        On Error Goto 0
Else
   CreateFullPath = True
   'msgbox("Le dossier Date existe déjà")
End If
 
Set objFileSystemObject = Nothing
 
Set oFSO = CreateObject("Scripting.FileSystemObject") 
Set oCrFld= CreateObject("Scripting.FileSystemObject")
 
set oFld = oFSO.GetFolder("F:\CopyTool\Data") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\Data")
oFld.Copy "W:\SIM09\" & Date & "\Data",True
set oFld = oFSO.GetFolder("F:\CopyTool\RawData") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\RawData")
oFld.Copy "W:\SIM09\" & Date & "\RawData",True
set oFld = oFSO.GetFolder("F:\Zoes") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\Zoes")
oFld.Copy "W:\SIM09\" & Date & "\Zoes",True
 
oExec.Terminate
WScript.Quit
 
Function FolderExists(strFolderPath)
    Dim fileObject
 
    Set fileObject = CreateObject("Scripting.FileSystemObject")
 
    On Error Resume Next ' Si erreur, continuer
    FolderExists     = fileObject.FolderExists(strFolderPath)
    If Err.number <> 0 Then
        FolderExists = False
        Call Err.Clear()
    End If
    On Error Goto 0
    Set fileObject = Nothing
End Function
 
Function repl(m,p,s)
    repl =  "W:\SIM09\" & Date 
End Function

Je pense que ça doit être un truc simple, mais je ne comprends pas bien..

[Cachlab]

EDIT : Première réponse erronée !

Bonjour,

Peux-tu essayer ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Dim objFileSystemObject, fsO, FL, FD, strFolderPath, oFSO, oFld 
Dim oSh, oExec, sK, ScriptPath
 
Set oSh=CreateObject("WScript.Shell")
If WScript.Arguments.Count = 1 Then
If WScript.Arguments(0) = "popup" Then
While True
oSh.Popup "Copie en cours, patientez..."
Wend
End If
End If
 
Set oExec=oSh.Exec ("WScript " & WScript.ScriptFullName & " popup") : oExec.Terminate
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
strFolderPath = "F:\CopyTool"
 
If Not objFileSystemObject.FolderExists(strFolderPath) Then
	msgBox("Vérifiez que le lecteur USB3.0 est bien référencé en lecteur réseau F:\, ou bien vérifiez qu'il existe bien un répertoire CopyTool sur le disque de données.")
Else 
	Set FD = fso.GetFolder("F:\CopyTool\Database")
	FD.Name="Data"
End If
Set fso = Nothing
Set FD = Nothing
 
Set fso = CreateObject("Scripting.FileSystemObject")
 
path = "C:\bvsys\TurnoutView3.7.2\Parameter\Directories.var"
content = fso.OpenTextFile(path,1).ReadAll
With New RegExp 
        .Global = True
        .Pattern = "W:\\SIM09\\[^\\]+"
        srepl = .Replace(content, GetRef("repl"))
End With 
fso.CreateTextFile(path,True).Write srepl
 
Set objFileSystemObject = CreateObject("Scripting.FileSystemObject")
 
strFolderPath = "W:\SIM09\" & Date
 
CreateFullPath = False
If Not objFileSystemObject.FolderExists(strFolderPath) Then
	Set fs = CreateObject("Scripting.FileSystemObject") 
	fs.CreateFolder (strFolderPath)
	    'msgbox("Dossier Date créé")
        If Err.number <> 0 Then
           CreateFullPath = False ' Error while creating
           Call Err.Clear()
        End If
        On Error Goto 0
Else
   CreateFullPath = True
   'msgbox("Le dossier Date existe déjà")
End If
 
Set objFileSystemObject = Nothing
 
Set oFSO = CreateObject("Scripting.FileSystemObject") 
Set oCrFld= CreateObject("Scripting.FileSystemObject")
 
set oFld = oFSO.GetFolder("F:\CopyTool\Data") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\Data")
oFld.Copy "W:\SIM09\" & Date & "\Data",True
set oFld = oFSO.GetFolder("F:\CopyTool\RawData") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\RawData")
oFld.Copy "W:\SIM09\" & Date & "\RawData",True
set oFld = oFSO.GetFolder("F:\Zoes") 
oCrFld.CreateFolder("W:\SIM09\" & Date & "\Zoes")
oFld.Copy "W:\SIM09\" & Date & "\Zoes",True
 
WScript.Quit
 
Function FolderExists(strFolderPath)
    Dim fileObject
 
    Set fileObject = CreateObject("Scripting.FileSystemObject")
 
    On Error Resume Next ' Si erreur, continuer
    FolderExists     = fileObject.FolderExists(strFolderPath)
    If Err.number <> 0 Then
        FolderExists = False
        Call Err.Clear()
    End If
    On Error Goto 0
    Set fileObject = Nothing
End Function
 
Function repl(m,p,s)
    repl =  "W:\SIM09\" & Date 
End Function

[hackoofr]

Essayez d’adapter ce bout de code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
Dim fso,ws,Temp,Titre,MsgTitre,MsgAttente,Copyright,oExec
Set fso = CreateObject("Scripting.FileSystemObject")
Copyright = "© Hackoo © 2014"
Set ws = CreateObject("WScript.Shell")
Temp = ws.ExpandEnvironmentStrings("%Temp%")
Titre = "Veuillez patienter le proccessus de la copie est en cours . . . " & Copyright
MsgAttente = "Veuillez patienter le proccessus de la copie est en cours . . ." 
Call CreateProgressBar(Titre,MsgAttente)
Call LancerProgressBar()
'******************************************************************
'Pause de 30s pour simuler un processus (copie par exemple) en cours.
'Vous pouvez remplacer cette pause par votre programme prinicpal.
Call Pause(30) 
'******************************************************************
Call FermerProgressBar()
MsgBox "La copie est terminé !",VbInformation,"La copie est terminé !"
'***********************************************************************************************************
Sub CreateProgressBar(Titre,MsgAttente)
    Dim ws,fso,f,f2,ts,ts2,Ligne,i,fread,LireTout,NbLigneTotal,Temp,PathOutPutHTML,fhta,oExec
    Set ws = CreateObject("wscript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Temp = WS.ExpandEnvironmentStrings("%Temp%")
    PathOutPutHTML = Temp & "\Barre.hta"
    Set fhta = fso.OpenTextFile(PathOutPutHTML,2,True)
    fhta.WriteLine "<HTML>"
    fhta.WriteLine "<HEAD>"
    fhta.WriteLine "<Title>  " & Titre & "</Title>"
    fhta.WriteLine "<HTA:APPLICATION"
    fhta.WriteLine "ICON = ""magnify.exe"" "
    fhta.WriteLine "BORDER=""THIN"" "
    fhta.WriteLine "INNERBORDER=""NO"" "
    fhta.WriteLine "MAXIMIZEBUTTON=""NO"" "
    fhta.WriteLine "MINIMIZEBUTTON=""NO"" "
    fhta.WriteLine "SCROLL=""NO"" "
    fhta.WriteLine "SYSMENU=""NO"" "
    fhta.WriteLine "SELECTION=""NO"" "
    fhta.WriteLine "SINGLEINSTANCE=""YES"">"
    fhta.WriteLine "</HEAD>"
    fhta.WriteLine "<BODY text=""white""><CENTER>"
    fhta.WriteLine "<marquee DIRECTION=""LEFT"" SCROLLAMOUNT=""3"" BEHAVIOR=ALTERNATE><font face=""Comic sans MS"">" & MsgAttente &"</font></marquee>"
    fhta.WriteLine "<img src=""data:image/gif;base64,R0lGODlhgAAPAPIAAP////INPvvI0/q1xPVLb/INPgAAAAAAACH/C05FVFNDQVBFMi4wAwEAAAAh/hpDcmVhdGVkIHdpdGggYWpheGxvYWQuaW5mbwAh+QQJCgAAACwAAAAAgAAPAAAD5wiyC/6sPRfFpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwDkJEDE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/4ixgeloM5erDHonOWBFFlJoxiiTFtqWwa/Jhx/86nKdc7vuJ6mxaABbUaUTvljBo++pxO5nFQFxMY1aW12pV+q9yYGk6NlW5bAPQuh7yl6Hg/TLeu2fssf7/19Zn9meYFpd3J1bnCMiY0RhYCSgoaIdoqDhxoFnJ0FFAOhogOgo6GlpqijqqKspw+mrw6xpLCxrrWzsZ6duL62qcCrwq3EsgC0v7rBy8PNorycysi3xrnUzNjO2sXPx8nW07TRn+Hm3tfg6OLV6+fc37vR7Nnq8Ont9/Tb9v3yvPu66Xvnr16+gvwO3gKIIdszDw65Qdz2sCFFiRYFVmQFIAEBACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9J2qd1AoM9MYeF4KaWJKWmaJXxEyulI3zWa/39Xh6/vkT3q/DC/JiBFjMSCM2hUybUwrdFa3Pqw+pdEVxU3AViKVqwz30cKzmQpZl8ZlNn9uzeLPH7eCrv2l1eXKDgXd6Gn5+goiEjYaFa4eOFopwZJh/cZCPkpGAnhoFo6QFE6WkEwOrrAOqrauvsLKttKy2sQ+wuQ67rrq7uAOoo6fEwsjAs8q1zLfOvAC+yb3B0MPHD8Sm19TS1tXL4c3jz+XR093X28ao3unnv/Hv4N/i9uT45vqr7NrZ89QFHMhPXkF69+AV9OeA4UGBDwkqnFiPYsJg7jBktMXhD165jvk+YvCoD+Q+kRwTAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJdCLnC/S+nsCFo1dq5zeRoFlJ1Du91hOq3b3qNo/5OdZPGDT1QrSZDLIcGp2o47MYheJuImmVer0lmRVlWNslYndm4Jmctba5gm9sPI+gp2v3fZuH78t4Xk0Kg3J+bH9vfYtqjWlIhZF0h3qIlpWYlJpYhp2DjI+BoXyOoqYaBamqBROrqq2urA8DtLUDE7a1uLm3s7y7ucC2wrq+wca2sbIOyrCuxLTQvQ680wDV0tnIxdS/27TND+HMsdrdx+fD39bY6+bX3um14wD09O3y0e77+ezx8OgAqutnr5w4g/3e4RPIjaG+hPwc+stV8NlBixAzSlT4bxqhx46/MF5MxUGkPA4BT15IyRDlwG0uG55MAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPECwbnu3gUKH1h2ZziNKVlJWDW9FvSuI/nkusPjrF0OaBIGfTna7GaTNTPGIvK4GUZRV1WV+ssKlE/G0hmDTqVbdPeMZWvX6XacAy6LwzAF092b9+GAVnxEcjx1emSIZop3g16Eb4J+kH+ShnuMeYeHgVyWn56hakmYm6WYnaOihaCqrh0FsbIFE7Oytba0D7m6DgO/wAMTwcDDxMIPx8i+x8bEzsHQwLy4ttWz17fJzdvP3dHfxeG/0uTjywDK1Lu52bHuvenczN704Pbi+Ob66MrlA+scBAQwcKC/c/8SIlzI71/BduysRcTGUF49i/cw5tO4jytjv3keH0oUCJHkSI8KG1Y8qLIlypMm312ASZCiNA0X8eHMqPNCTo07iyUAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8hffaB3ZiWJKfmaJgJWHV5FqQK9uPuDr6yPeTniAIzBV/utktVmPCOE8GUTc9Ia0AYXWXPXaTuOhr4yRDzVIjVY3VsrnuK7ynbJ7rYlp+6/u2vXF+c2tyHnhoY4eKYYJ9gY+AkYSNAotllneMkJObf5ySIphpe3ajiHqUfENvjqCDniIFsrMFE7Sztre1D7q7Dr0TA8LDA8HEwsbHycTLw83ID8fCwLy6ubfXtNm40dLPxd3K4czjzuXQDtID1L/W1djv2vHc6d7n4PXi+eT75v3oANSxAzCwoLt28P7hC2hP4beH974ZTEjwYEWKA9VBdBixLSNHhRPlIRR5kWTGhgz1peS30l9LgBojUhzpa56GmSVr9tOgcueFni15styZAAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKsWIPiFwhia4kWWKrl5UGXFMFa/nJ0Da+r0rF9vAiQOH0DZTMeYKJ0y6O2JPApXRmxVe3VtSVSmRLzENWm7MM+65ra93dNXHgep71H0mSzdFec+b3SCgX91AnhTeXx6Y2aOhoRBkllwlICIi49liWmaapGhbKJuSZ+niqmeN6SWrYOvIAWztAUTtbS3uLYPu7wOvrq4EwPFxgPEx8XJyszHzsbQxcG9u8K117nVw9vYD8rL3+DSyOLN5s/oxtTA1t3a7dzx3vPwAODlDvjk/Orh+uDYARBI0F29WdkQ+st3b9zCfgDPRTxWUN5AgxctVqTXUDNix3QToz0cGXIaxo32UCo8+OujyJIM95F0+Y8mMov1NODMuPKdTo4hNXgMemGoS6HPEgAAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9pcgitpIhmaZouMGYq/LwbPMTJVE34/Z9j7BJCgE+obBnAWSwzWZMaUz+nQQkUfjyhrEmqTQGnins5XH5iU3u94Crtpfe4SuV9NT8R0Nn5/8RYBedHuFVId6iDyCcX9vXY2Bjz52imeGiZmLk259nHKfjkSVmpeWanhhm56skIyABbGyBROzsrW2tA+5ug68uLbAsxMDxcYDxMfFycrMx87Gv7u5wrfTwdfD2da+1A/Ky9/g0OEO4MjiytLd2Oza7twA6/Le8LHk6Obj6c/8xvjzAtaj147gO4Px5p3Dx9BfOQDnBBaUeJBiwoELHeaDuE8uXzONFu9tE2mvF0KSJ00q7Mjxo8d+L/9pRKihILyaB29esEnzgkt/Gn7GDPosAQAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTcJJKmV5oUKJ7qBGPyKMzNVUkzjFoSPK9YjKHQQgSve7eeTKZs7ps4GpRqDSNcQu01Kazlwbxp+ksfipezY1V5X2ZI5XS1/5/j7l/12A/h/QXlOeoSGUYdWgXBtJXEpfXKFiJSKg5V2a1yRkIt+RJeWk6KJmZhogKmbniUFrq8FE7CvsrOxD7a3Drm1s72wv7QPA8TFAxPGxcjJx8PMvLi2wa7TugDQu9LRvtvAzsnL4N/G4cbY19rZ3Ore7MLu1N3v6OsAzM0O9+XK48Xn/+notRM4D2C9c/r6Edu3UOEAgwMhFgwoMR48awnzMWOIzyfeM4ogD4aMOHJivYwexWlUmZJcPXcaXhKMORDmBZkyWa5suE8DuAQAIfkECQoAAAAsAAAAAIAADwAAA/8ItAv+rD0XyaTxqnyr9h03gZNgmtqJXqqwka8YM2NlQXYN2ze254/WyiF0BYU8nSyJ+zmXQB8UViwJrS2mlNacerlbSbg3E5fJ1WMLq9KeleB3N+6uR+XEq1rFPtmfdHd/X2aDcWl5a3t+go2AhY6EZIZmiACWRZSTkYGPm55wlXqJfIsmBaipBROqqaytqw+wsQ6zr623qrmusrATA8DBA7/CwMTFtr24yrrMvLW+zqi709K0AMkOxcYP28Pd29nY0dDL5c3nz+Pm6+jt6uLex8LzweL35O/V6fv61/js4m2rx01buHwA3SWEh7BhwHzywBUjOGBhP4v/HCrUyJAbXUSDEyXSY5dOA8l3Jt2VvHCypUoAIetpmJgAACH5BAkKAAAALAAAAACAAA8AAAP/CLQL/qw9F8mk8ap8q/YdN4Gj+AgoqqVqJWHkFrsW5Jbzbee8yaaTH4qGMxF3Rh0s2WMUnUioQygICo9LqYzJ1WK3XiX4Na5Nhdbfdy1mN8nuLlxMTbPi4be5/Jzr+3tfdSdXbYZ/UX5ygYeLdkCEao15jomMiFmKlFqDZz8FoKEFE6KhpKWjD6ipDqunpa+isaaqqLOgEwO6uwO5vLqutbDCssS0rbbGuMqsAMHIw9DFDr+6vr/PzsnSx9rR3tPg3dnk2+LL1NXXvOXf7eHv4+bx6OfN1b0P+PTN/Lf98wK6ExgO37pd/pj9W6iwIbd6CdP9OmjtGzcNFsVhDHfxDELGjxw1Xpg4kheABAAh+QQJCgAAACwAAAAAgAAPAAAD/wi0C/6sPRfJpPGqfKv2HTeBowiZjqCqG9malYS5sXXScYnvcP6swJqux2MMjTeiEjlbyl5MAHAlTEarzasv+8RCu9uvjTuWTgXedFhdBLfLbGf5jF7b30e3PA+/739ncVp4VnqDf2R8ioBTgoaPfYSJhZGIYhN0BZqbBROcm56fnQ+iow6loZ+pnKugpKKtmrGmAAO2twOor6q7rL2up7C/ssO0usG8yL7KwLW4tscA0dPCzMTWxtXS2tTJ297P0Nzj3t3L3+fmzerX6M3hueTp8uv07ezZ5fa08Piz/8UAYhPo7t6+CfDcafDGbOG5hhcYKoz4cGIrh80cPAOQAAAh+QQJCgAAACwAAAAAgAAPAAAD5wi0C/6sPRfJpPGqfKv2HTeBowiZGLORq1lJqfuW7Gud9YzLud3zQNVOGCO2jDZaEHZk+nRFJ7R5i1apSuQ0OZT+nleuNetdhrfob1kLXrvPariZLGfPuz66Hr8f8/9+gVh4YoOChYhpd4eKdgwFkJEFE5KRlJWTD5iZDpuXlZ+SoZaamKOQp5wAm56loK6isKSdprKotqqttK+7sb2zq6y8wcO6xL7HwMbLtb+3zrnNycKp1bjW0NjT0cXSzMLK3uLd5Mjf5uPo5eDa5+Hrz9vt6e/qosO/GvjJ+sj5F/sC+uMHcCCoBAA7AAAAAAAAAAAA"" />"
    fhta.WriteLine "</CENTER></BODY></HTML>"
    fhta.WriteLine "<SCRIPT LANGUAGE=""VBScript""> "
    fhta.WriteLine "Set ws = CreateObject(""wscript.Shell"")"
    fhta.WriteLine "Temp = WS.ExpandEnvironmentStrings(""%Temp%"")"
    fhta.WriteLine "Sub window_onload()"
    fhta.WriteLine "    CenterWindow 500,110"
    fhta.WriteLine "    Self.document.bgColor = ""DarkOrange"" "
    fhta.WriteLine " End Sub"
    fhta.WriteLine " Sub CenterWindow(x,y)"
    fhta.WriteLine "    Dim iLeft,itop"
    fhta.WriteLine "    window.resizeTo x,y"
    fhta.WriteLine "    iLeft = window.screen.availWidth/2 - x/2"
    fhta.WriteLine "    itop = window.screen.availHeight/2 - y/2"
    fhta.WriteLine "    window.moveTo ileft,itop"
    fhta.WriteLine "End Sub"
    fhta.WriteLine "</script>"
    fhta.close
End Sub
'**********************************************************************************************
Sub LancerProgressBar()
    Set oExec = Ws.Exec("mshta.exe " & Temp & "\Barre.hta")
End Sub
'**********************************************************************************************
Sub FermerProgressBar()
    oExec.Terminate
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
    Wscript.Sleep(NSeconds*1000)
End Sub  
'**********************************************************************************************
Function DblQuote(Str)
    DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************

[omen999]

bonjour,

Je pense que ça doit être un truc simple, mais je ne comprends pas bien..

c'est toujours le même problème avec le copié/collé, y'a toujours des bouts qui se perdent en route ou qui
ne sont pas raccord...supprime ta ligne oExec.Terminate qui ne sert à rien

[nikkss]

Merci bien à tous.
Je regarde ça asap.

Résolu.

[l_autodidacte]

Merci bien à tous.
Je regarde ça asap.
Résolu.

Si c'est résolu, merci de cliquer sur le bouton en bas de cette page