Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

Beliebteste Forumthreads (12 Monate)

Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Systemlautstärke per Sendkeys ändern, Zahl per Inputbox

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread