Bouton pour baisser le volume du son

**patricktoulon** · 26/05/2014, 14h55

Bonjour
je suis entrain de créer une nouvelle application (HTA)avec du vbscript dedans

et je cherche comment mettre deux boutons (+/-) pour baisser et monter le volume

quelqu'un aurait une piste

merci d'avance

**omen999** · 26/05/2014, 16h26

bonjour,

le contrôle spinbutton pourrait faire l'affaire
exemple hta :

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
<html>
<head>
<title> objects </title>
<HTA:Application />
<script language="vbscript">
    sub spntest_change
      txtspinvalue.value = spntest.value
    end sub
</script>
</head>
<body>
Spin value:<input type="text" name="txtspinvalue">
<object 
    id="spntest"
    classid="clsid:79176fb0-b7f2-11ce-97ef-00aa006d2776" 
    codebase="http://activex.microsoft.com/controls/mspert10.cab"
    >
</object>
</body>
</html>

ce contrôle fait partie de la "Microsoft Forms 2.0 Object library"

**patricktoulon** · 26/05/2014, 17h20

Bonjour ommen999

le bouton sympa mais ca ne change page pas le volume

travaillant sur vba habituellement je me doute que ca doit être un peu plus compliqué c'est la partie vbs que je cherche mais je ne trouve rien

merci pour le coup de main

je cherche toujours

**patricktoulon** · 27/05/2014, 12h28

Bonjour a tous

voila j'ai glaner ici et la des méthode utilisant du WSH dans un fichier vbs

Attention c'est valable pour seven pour inferieur c'est "SndVol32"
exemple de fichier VBS seul

Code :

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

1
2
3
4
5
set oShell = CreateObject("WScript.Shell") 
oShell.run"%SystemRoot%\System32\SndVol.exe" 'Runs The Master Volume App.
WScript.Sleep 100 'Waits For The Program To Open
oShell.SendKeys("{PGUP}") 'Turns Up The Volume 20, If It Is Muted Then It Will Unmute It
oShell.SendKeys"%{F4}"  ' ALT

seul problème le WSH n'est pas compatible avec un hta étant donné que les fonction vbs sont interne dans le HTA

donc j'utilise la fonction shellececute
et voila le code

Code :

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

1
2
3
4
5
6
 
Set objShell = CreateObject("Shell.Application")
 objShell.ShellExecute "C:\Windows\System32\SndVol.exe" , "", "", "runas", 1
 
 objShell.SendKeys("{UP}") 'Turns Up The Volume 20, If It Is Muted Then It Will Unmute It
 objShell.SendKeys"%{F4}"  ' ALT

ca ouvre bien le panneau de son

seul problème objshell ne gère pas le sendkey c'est en tout cas l'erreur qui est affichée

quelqu'un a une idée ?

**hackoofr** · 27/05/2014, 19h46

A la limite 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
<html>
<head>
<HTA:APPLICATION 
APPLICATIONNAME="Volume + -" 
BORDER="THIN" 
BORDERSTYLE="NORMAL" 
ICON="SndVol.exe" 
INNERBORDER="NO" 
MAXIMIZEBUTTON="NO" 
MINIMIZEBUTTON="NO" 
SCROLL="NO" 
SELECTION="NO" 
SINGLEINSTANCE="YES"/>
<title> Volume + - </title>
<SCRIPT LANGUAGE="VBScript">
' Position screen
Const WinWidth = 265, WinHeight = 198  ' dialog size
Const pxLeft = 111, pxTop = 55  ' positioning
  window.ResizeTo WinWidth,WinHeight
  window.MoveTo pxLeft,pxTop
</SCRIPT>
<script language="vbscript">
'************************************************************************************
Sub window_onload()
    CenterWindow 200,100
End Sub
'************************************************************************************
Sub Sleep(MSecs)' Fonction pour faire une pause car wscript.sleep ne marche pas dans un HTA 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
    Dim tempName : tempName = "Sleeper.vbs"
    If Not Fso.FileExists(tempFolder&"\"&tempName) Then
        Set objOutputFile = fso.CreateTextFile(tempFolder&"\"&tempName, True)
        objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
        objOutputFile.Close
    End If
    CreateObject("WScript.Shell").Run tempFolder&"\"&tempName &" "& MSecs,1,True
End Sub
'************************************************************************************
Sub VolumeUP()
set oShell = CreateObject("WScript.Shell") 
oShell.run "%SystemRoot%\System32\SndVol.exe" 'Runs The Master Volume App.
Sleep 1000 'Waits For The Program To Open
oShell.SendKeys("{UP}") 'Turns Up The Volume 20, If It Is Muted Then It Will Unmute It
Sleep 1000
oShell.SendKeys"%{F4}"  ' ALT + F4
End Sub
'************************************************************************************
Sub VolumeDOWN()
set oShell = CreateObject("WScript.Shell") 
oShell.run "%SystemRoot%\System32\SndVol.exe" 'Runs The Master Volume App.
Sleep 1000 'Waits For The Program To Open
oShell.SendKeys("{DOWN}") 'Turns Up The Volume 20, If It Is Muted Then It Will Unmute It
Sleep 1000
oShell.SendKeys"%{F4}"  ' ALT + F4
End Sub
'*************************************************************************************
Sub CenterWindow(x,y)
    Dim iLeft,itop
    window.resizeTo x,y
    iLeft = window.screen.availWidth/2 - x/2
    itop = window.screen.availHeight/2 - y/2
    window.moveTo ileft,itop
End Sub
'************************************************************************************
</script>
</head>
<body>
<center>
<BUTTON style="background: Green; color: white;" onClick="VolumeUP()" style="WIDTH: 60px; HEIGHT: 30px">Volume +</BUTTON>&nbsp;&nbsp;
<BUTTON style="background: Blue; color: white;" onClick="VolumeDOWN()" style="WIDTH: 60px; HEIGHT: 30px">Volume -</BUTTON>&nbsp;&nbsp;
</center>
</body>
</html>

**ProgElecT** · 27/05/2014, 23h06

En toutes rigueurs, pour faire des sauts de 20%, les SendKeys
oShell.SendKeys("{PGUP}") volume +20%
oShell.SendKeys("{PGDN}") volume -20%
oShell.SendKeys(" " & chr(173)) permet de couper/remettre le son (bascule)
oShell.SendKeys("{HOME}") volume maximum 100%
oShell.SendKeys("{END}") volume minimum 0%

Bouton pour baisser le volume du son

VBScript

Vue hybride

Discussions similaires

Partager

Partager