Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Lautstärke einstellen VBA API
#1
Photo 
Hallo
Möchte mit Vba die Lautstärke ändern. Win10, Excel 2013
Muss da unten Wirkung zeigen!

   

MfG Link
Antwortento top
#2
Moin!
Google kaputt?
https://www.herber.de/forum/archiv/1132t...r_VBA.html

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)
Antwortento top
#3
Hallo
Da war ich schon. Zeigt keine Wirkung!
MfG Link
Antwortento top
#4
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
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
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)
Antwortento top
#5
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
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste