Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

Forumthread: Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

02.09.2023 09:51:02

Dieter(Drummer)

Guten Morgen an alle ...

in meiner Musterdatei kann per Klick die Systemlautsärke z.B. auf 70% oder 30% geändert werden, egal welcher Wert vorher eingestellt war.
Das geht per Sendkeys ohne Probleme.

Wie muss der Code aussehen, damit die Lautsärke per Zahl in InputBox ausgewählt und gesetzt wird?
Dann brauche ich ja nur diesen einen Wert für die Lautstärke zu setzen.

Mit der Bitte um Hilfe, grüßt
Dieter(Drummer)

Musterdatei mit Code in Modul1
https://www.herber.de/bbs/user/162654.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

02.09.2023 10:05:45

Nepumuk

Hallo Dieter,

teste mal:

Option Explicit



Private Declare PtrSafe Function SendMessageA Lib "user32.dll" ( _

    ByVal hwnd As LongPtr, _

    ByVal wMsg As Long, _

    ByVal wParam As LongPtr, _

    ByRef lParam As Any) As LongPtr



Private Const APPCOMMAND_VOLUME_MUTE As Long = &H80000

Private Const APPCOMMAND_VOLUME_UP As Long = &HA0000

Private Const APPCOMMAND_VOLUME_DOWN As Long = &H90000



Private Const WM_APPCOMMAND As Long = &H319



Public Sub Lautstaerke()



    'Systemlautsärke setzen. Schrittweite ist jeweils 2



    Dim strInput As String

    Dim lngIndex As Long



    Do



        strInput = InputBox("Lautstärke von 0 bis 100 eingeben.", "Eingabe")



        If StrPtr(strInput) = 0 Then Exit Sub



        If Val(strInput) >= 0 And Val(strInput) = 100 Then Exit Do



        Call MsgBox("Bitte nur Zahlen zwischen 0 und 100 eingeben.", vbExclamation, "Hinweis")



    Loop



    For lngIndex = 1 To 50



        'Lautstärke auf 0 setzen

        Call SendMessageA(CLngPtr(Application.hwnd), WM_APPCOMMAND, 0^, ByVal APPCOMMAND_VOLUME_DOWN)



    Next



    For lngIndex = 1 To Val(strInput) / 2



        'Lautstärke setzen

        Call SendMessageA(CLngPtr(Application.hwnd), WM_APPCOMMAND, 0^, ByVal APPCOMMAND_VOLUME_UP)



    Next

End Sub

Gruß
Nepumuk

Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

02.09.2023 10:21:47

Dieter(Drummer)

Guten Morgen Nepumuk
und Danke für Rückmeldung..

Ich dachte, dass es mit meinem kurzen Code und InputBox einfacher geht.

Dein Code bricht mit Fehlermeldung: Fehler beim Kompilieren: Syntaxfehler ab. Zeille "Call SendMessageA(CLngPtr(Application.hwnd), WM_APPCOMMAND, 0^, ByVal APPCOMMAND_VOLUME_DOWN)" wird markiert.

Hast Du da eine Lösung?

Gruß, Dieter(Drummer)

Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

02.09.2023 10:30:49

Nepumuk

Hallo Dieter,

ich habe gerade gesehen dass du noch eine Urururururgroßmutter von Excel hast. Dann so:

Option Explicit



Private Declare  Function SendMessageA Lib "user32.dll" ( _

    ByVal hwnd As Long, _

    ByVal wMsg As Long, _

    ByVal wParam As Long, _

    ByRef lParam As Any) As Long



Private Const APPCOMMAND_VOLUME_MUTE As Long = &H80000

Private Const APPCOMMAND_VOLUME_UP As Long = &HA0000

Private Const APPCOMMAND_VOLUME_DOWN As Long = &H90000



Private Const WM_APPCOMMAND As Long = &H319



Public Sub Lautstaerke()



    'Systemlautsärke setzen. Schrittweite ist jeweils 2



    Dim strInput As String

    Dim lngIndex As Long



    Do



        strInput = InputBox("Lautstärke von 0 bis 100 eingeben.", "Eingabe")



        If StrPtr(strInput) = 0 Then Exit Sub



        If Val(strInput) >= 0 And Val(strInput) = 100 Then Exit Do



        Call MsgBox("Bitte nur Zahlen zwischen 0 und 100 eingeben.", vbExclamation, "Hinweis")



    Loop



    For lngIndex = 1 To 50



        'Lautstärke auf 0 setzen

        Call SendMessageA(Application.hwnd, WM_APPCOMMAND, 0, ByVal APPCOMMAND_VOLUME_DOWN)



    Next



    For lngIndex = 1 To Val(strInput) / 2



        'Lautstärke setzen

        Call SendMessageA(Application.hwnd, WM_APPCOMMAND, 0, ByVal APPCOMMAND_VOLUME_UP)



    Next

End Sub

Gruß
Nepumuk

Danke Nepumuk, funktioniert prima ...

02.09.2023 10:35:56

Dieter(Drummer)

Hallo Nepumuk,

... so geht es problemlos.

Danke und Gruß,
Dieter(DRummer)

Beliebteste Forumthreads (12 Monate)

Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

Forumthread: Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread