Registriert seit: 17.05.2020
Version(en): 2013
17.05.2020, 16:33
Hallo
Möchte mit Vba die Lautstärke ändern. Win10, Excel 2013
Muss da unten Wirkung zeigen!
MfG Link
Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 17.05.2020
Version(en): 2013
Hallo
Da war ich schon. Zeigt keine Wirkung!
MfG Link
Registriert seit: 12.10.2014
Version(en): 365 Insider (32 Bit)
17.05.2020, 17:32
(Dieser Beitrag wurde zuletzt bearbeitet: 17.05.2020, 17:32 von RPP63.)
Ich bin zur Zeit am Phone und kann das erst gleich testen.
Ich melde mich gleich.
Hast Recht, funktioniert nicht.
Nimm dies, ist getestet und funktioniert bei mir:
Modul Modul1Option 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
Sub VolUp()
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 0, 3, 0
End Sub
Sub VolDown()
keybd_event VK_VOLUME_DOWN, 0, 1, 0
keybd_event VK_VOLUME_DOWN, 0, 3, 0
End Sub
Sub VolToggle()
keybd_event VK_VOLUME_MUTE, 0, 1, 0
End Sub
Stammt von hier:
https://wellsr.com/vba/2016/excel/use-vb...lume-down/
(übrigens auch mittels Suchmaschinee gefunden …)
Gruß Ralf
Gib einem Mann einen Fisch und du ernährst ihn für einen Tag.
Lehre einen Mann zu fischen und du ernährst ihn für sein Leben. (Konfuzius)
Registriert seit: 17.05.2020
Version(en): 2013
Hallo
Das funktioniert!
Danke für die Mühe.
Habe es noch ein bisschen geändert.
MfG Link
Code: Const VK_VOLUME_MUTE = &HAD
Const VK_VOLUME_DOWN = &HAE
Const VK_VOLUME_UP = &HAF
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long
Sub VolDown()
keybd_event VK_VOLUME_DOWN, 0, 1, 0
keybd_event VK_VOLUME_DOWN, 0, 3, 0
End Sub
Sub DoNothing(Finish As Long)
Dim NowTick As Long
Dim EndTick As Long
EndTick = GetTickCount + (Finish * 10000)
Do
NowTick = GetTickCount
DoEvents
Loop Until NowTick >= EndTick
End Sub
Sub MinimumVolume()
Dim i As Integer
For i = 1 To 100
Call VolDown
Next i
End Sub
Sub VolMe()
Application.EnableCancelKey = xlErrorHandler 'ESC beendet Schleife
On Error GoTo ERRORHANDLER
MinimumVolume
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
keybd_event VK_VOLUME_UP, 0, 1, 0
keybd_event VK_VOLUME_UP, 1, 5, 1
Dim Text
Dim prüfen
Application.Wait (Now + TimeValue("0:00:02"))
Application.Speech.Speak "Heute" 'Heute
If Not Tabelle1.Range("AE8").Value = " " Then
Application.Wait (Now + TimeValue("0:00:01"))
strText = Worksheets("K").Range("AE8")
Application.Speech.Speak "" & strText
End If
If Not Tabelle1.Range("AG8").Value = " " Then
Application.Wait (Now + TimeValue("0:00:01"))
strText = Worksheets("K").Range("AG8")
Application.Speech.Speak "" & strText
End If
Application.Wait (Now + TimeValue("0:00:01"))
Application.Speech.Speak "Morgen" 'Morgen
If Not Tabelle1.Range("AE9").Value = " " Then
Application.Wait (Now + TimeValue("0:00:01"))
strText = Worksheets("K").Range("AE9")
Application.Speech.Speak "" & strText
End If
If Not Tabelle1.Range("AG9").Value = " " Then
Application.Wait (Now + TimeValue("0:00:01"))
strText = Worksheets("K").Range("AG9")
Application.Speech.Speak "" & strText
End If
Application.Wait (Now + TimeValue("0:00:01"))
Application.Speech.Speak "Übermorgen" 'Übermorgen
If Not Tabelle1.Range("AE10").Value = " " Then
Application.Wait (Now + TimeValue("0:00:01"))
strText = Worksheets("K").Range("AE10")
Application.Speech.Speak "" & strText
End If
If Not Tabelle1.Range("AG10").Value = " " Then
Application.Wait (Now + TimeValue("0:00:01"))
strText = Worksheets("K").Range("AG10")
Application.Speech.Speak "" & strText
End If
ERRORHANDLER:
End Sub
|