Affichage d'un message d'attente pendant l’exécution du script

Version imprimable

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:

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.

17/07/2014, 10h01
nikkss

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

Résolu, et bonne journée à tous!
17/07/2014, 10h32
hackoofr

Citation:

Envoyé par nikkss

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

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

Bien sûr,

Code:

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")

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

Code:

oExec.Terminate

Dans mon code global:

Code:

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.. :oops:

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

Bonjour,

Peux-tu essayer ceci :

Code:

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

Message d'attente avec une barre de progression

:salut:
Essayez d’adapter ce bout de code :king:

Code:

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
'**********************************************************************************************

17/07/2014, 21h35
omen999

bonjour,

Citation:

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 :roll:
18/07/2014, 08h53
nikkss

Merci bien à tous.
Je regarde ça asap.

Résolu.
18/07/2014, 10h21
l_autodidacte

Citation:

Envoyé par nikkss

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

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