Как можно записать изменение громкости системных звуков в Виндовс?
Задача: на время выполнения макроса надо сделать громкость в системе на 100% (так как наушники лежат на столе и при рабочей громкости через них не услышать подзвучку окончания процедуры). А после выполнения макроса вернуть громкость к существующему показателю. Типа процентов 30. Тогда в наушниках не будет закладывать уши при воспроизведении своих треков.
Код:
Option Explicit
Const VK_VOLUME_MUTE = &HAD
Const VK_VOLUME_DOWN = &HAE
Const VK_VOLUME_UP = &HAF
#If VBA7 Then
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If
Private Sub MaximumVolume()
Dim i%
For i = 1 To 100
DoEvents
Call VolUp
Next
End Sub
Private Sub MinimumVolume()
Dim i%
For i = 1 To 100
DoEvents
Call VolDown
Next
For i = 1 To 10
DoEvents
Call VolUp
Next
End Sub
Private Sub VolUp()
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 0, 2, 0
End Sub
Private Sub VolDown()
keybd_event VK_VOLUME_DOWN, 0, 1, 0
keybd_event VK_VOLUME_DOWN, 0, 2, 0
End Sub
Private Sub VolumeToggle()
keybd_event VK_VOLUME_MUTE, 0, 1, 0
End Sub
Private Sub cmd_Mute_Click()
Call VolumeToggle
End Sub
Private Sub cmd_VolDown_Click()
Call MinimumVolume
End Sub
Private Sub cmd_VolUp_Click()
Call MaximumVolume
End Sub
Const VK_VOLUME_MUTE = &HAD
Const VK_VOLUME_DOWN = &HAE
Const VK_VOLUME_UP = &HAF
#If VBA7 Then
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#Else
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If
Private Sub MaximumVolume()
Dim i%
For i = 1 To 100
DoEvents
Call VolUp
Next
End Sub
Private Sub MinimumVolume()
Dim i%
For i = 1 To 100
DoEvents
Call VolDown
Next
For i = 1 To 10
DoEvents
Call VolUp
Next
End Sub
Private Sub VolUp()
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 0, 2, 0
End Sub
Private Sub VolDown()
keybd_event VK_VOLUME_DOWN, 0, 1, 0
keybd_event VK_VOLUME_DOWN, 0, 2, 0
End Sub
Private Sub VolumeToggle()
keybd_event VK_VOLUME_MUTE, 0, 1, 0
End Sub
Private Sub cmd_Mute_Click()
Call VolumeToggle
End Sub
Private Sub cmd_VolDown_Click()
Call MinimumVolume
End Sub
Private Sub cmd_VolUp_Click()
Call MaximumVolume
End Sub
Большое спасибо. Все работает))