To BEEP or Not to BEEP

[Pacman52]

Hi all well dispite the usual google searches I can't find the true anwser to this so I thought I'd ask the expoerts on here !

So I have a lot of msgbox's on the project I'm working on, most of these use VBInformation but some use VBCritical ect.

Is is there a way through code to stop the Beep sounding for just VBInformation?

Thanks for any responses.

Paul

 

[pbornemeier]

This link had a start on it: Solved: Silence Sound when MsgBox is used?

 

[pbornemeier]

I think the easiest way would be to make a user form that just provided info for the times you don't want a sound, then use this structure to call either it or the normal msgbox:





This link shows info about a popup message that closes after a specified time (+/- a few seconds)
'Automatically Dismiss a Message Box
'Popup Method

 

[pbornemeier]

These links show how to use a popup msgbox that closes after set time:

Automatically Dismiss a Message Box

Office VBA reference topic

docs.microsoft.com

Popup Method

msdn.microsoft.com

 

[Pacman52]

Thank you so much for the reply and links I'll go through them and have a read and let you know if any resolve my 'issue'.

Thanks again Paul

 

[Jaafar Tribak]

Edited for correction.

 

[Jaafar Tribak]

You can use a wrapper for the MessageBoxIndirect api to display a mute MsgBox. This can be achieved by setting the MB_USERICON flag in the dwStyle member.

1- Place this code in a new Standard Module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function MessageBoxIndirect Lib "user32" Alias "MessageBoxIndirectW" (lpMsgBoxParams As MSGBOXPARAMS) As Long
    Private Declare PtrSafe Function MessageBeep Lib "user32" (ByVal wType As Long) As Long
#Else
    Private Enum LongPtr
    [_]
    End Enum
    Private Declare Function MessageBoxIndirect Lib "user32" Alias "MessageBoxIndirectW" (lpMsgBoxParams As MSGBOXPARAMS) As Long
    Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long
#End If

Private Type MSGBOXPARAMS
    cbSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpszText As LongPtr
    lpszCaption As LongPtr
    dwStyle As Long
    lpszIcon As LongPtr
    dwContextHelpId As LongPtr
    lpfnMsgBoxCallback As LongPtr
    dwLanguageId As Long
End Type

Public Function MuteMsgBox( _
    ByVal Prompt As String, _
    Optional Buttons As VbMsgBoxStyle, _
    Optional Title As String = "Microsoft Excel", _
    Optional Mute As Boolean = True _
) As VbMsgBoxResult

    Const MB_USERICON = &H80&
    Dim tMP As MSGBOXPARAMS
    Dim lIcon As Long
 
    lIcon = ExtractIcon(Buttons)
    If Mute = False And lIcon Then
        Call MessageBeep(lIcon)
    End If

    With tMP
        .cbSize = LenB(tMP)
        .hwndOwner = Application.hwnd
        .lpszText = StrPtr(Prompt)
        .lpszCaption = StrPtr(Title)
        .lpszIcon = IconID(lIcon)
        .dwStyle = IIf(.lpszIcon, ((Buttons + MB_USERICON) And Not (&H70&)), Buttons)
    End With
 
    MuteMsgBox = MessageBoxIndirect(tMP)

End Function

Private Function IconID(ByVal ID As VbMsgBoxStyle) As LongPtr
    Const IDI_WARNING = 101&, IDI_QUESTION = 102&
    Const IDI_ERROR = 103&, IDI_INFORMATION = 104&
    Select Case ID
        Case vbCritical
            IconID = IDI_ERROR
        Case vbQuestion
            IconID = IDI_QUESTION
        Case vbExclamation
            IconID = IDI_WARNING
        Case vbInformation
            IconID = IDI_INFORMATION
    End Select
End Function

Private Function ExtractIcon(Buttons As Long) As Long
    Dim i As Long
    For i = 16& To 64& Step 16&
        If (Buttons And i) = i Then
            ExtractIcon = i
        End If
    Next i
End Function

2- Code Usage Examples:

The MsgBox wrapper will be mute by default ... Only when setting the last Optional Mute argument to FALSE, the Msgbox beep sound will play.

Below are two examples to illustrate what I mean:

Sub TestMuteMsgbox()
    Call MuteMsgBox(Prompt:="This is a mute MsgBox", Buttons:=vbCritical)
End Sub

Sub TestInfoMsgbox()
    Call MuteMsgBox(Prompt:="Hello", Buttons:=vbInformation, Mute:=False)
End Sub