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
| Choix = ChooseOne("01 - Arbre_01,02 - Arbre_02,03 - Arbre_03,04 - Arbre_04,04 - Arbre_04,05 - Arbre_05,06 - Arbre_06,07 - Arbre_07,08 - Arbre_08")
MsgBox "Vous avez choisi " & Choix,64,"Votre Choix"
Function ChooseOne(Limiteparvirgule)
'Returns one of several string choices.
'Returns empty string if there is a problem.
Dim fs, web, doc
Dim strFile, strChoice
Dim intChars
Dim dtTime
On Error Resume Next
Set web = CreateObject("InternetExplorer.Application")
If web Is Nothing Then
ChooseOne = ""
Exit Function
End If
'Increase displayed width to accomodate longest string choice
intChars = 0
For Each strChoice In Split(Limiteparvirgule,",")
If Len(strChoice) > intChars Then intChars = Len(strChoice)
Next
If intChars > 20 Then
web.Width = 250 + 6 * (intChars - 20)
Else
web.Width = 250
End If
web.Height = 200
web.Offline = True
web.AddressBar = False
web.MenuBar = False
web.StatusBar = False
web.Silent = True
web.ToolBar = False
web.Navigate "about:blank"
'Wait for the browser to navigate to nowhere
dtTime = Now
Do While web.Busy
'Don't wait more than 5 seconds
Wscript.Sleep 100
If (dtTime + 5/24/60/60) < Now Then
ChooseOne = ""
web.Quit
Exit Function
End If
Loop
'Wait for a good reference to the browser document
Set doc = Nothing
dtTime = Now
Do Until Not doc Is Nothing
Wscript.Sleep 100
Set doc = web.Document
'Don't wait more than 5 seconds
If (dtTime + 5/24/60/60) < Now Then
ChooseOne = ""
web.Quit
Exit Function
End If
Loop
'Write the HTML form
doc.Write "<html><head><title>Choose</title></head>"
doc.Write "<body><b>Choose One:</b><br><form><select name=""choice"">"
For Each strChoice In Split(Limiteparvirgule,",")
doc.Write "<option value=""" & strChoice & """>" & strChoice
Next
doc.Write "</select>"
doc.Write "<br><br><input type=button "
doc.Write "name=submit "
doc.Write "value=""OK"" onclick='javascript:submit.value=""Done""'>"
doc.Write "</form></body></html>"
'Show the form
web.Visible = True
'Wait for the user to choose, but fail gracefully if a popup killer.
Err.Clear
Do Until doc.Forms(0).elements("submit").Value <> "OK"
Wscript.Sleep 100
If doc Is Nothing Then
ChooseOne = ""
web.Quit
Exit Function
End If
If Err.Number <> 0 Then
ChooseOne = ""
web.Quit
Exit Function
End If
Loop
'Retrieve the chosen value
ChooseOne = doc.Forms(0).elements("choice").Value
web.Quit
End Function |
[VBS] Liste Deroulante via (fichier init)
Répondre avec citation
Envoyé par bbil
un petit exemple pour créer une liste déroulante dynamique 
Partager