17.05.2020, 16:33
17.05.2020, 16:56
17.05.2020, 17:03
Hallo
Da war ich schon. Zeigt keine Wirkung!
MfG Link
Da war ich schon. Zeigt keine Wirkung!
MfG Link
17.05.2020, 17:32
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 Modul1
Stammt von hier:
https://wellsr.com/vba/2016/excel/use-vb...lume-down/
(übrigens auch mittels Suchmaschinee gefunden …)
Gruß Ralf
Ich melde mich gleich.
Hast Recht, funktioniert nicht.
Nimm dies, ist getestet und funktioniert bei mir:
Modul Modul1
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 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
17.05.2020, 20:42
Hallo
Das funktioniert!
Danke für die Mühe.
Habe es noch ein bisschen geändert.
MfG Link
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