How to create msgBox with button label Yes(Y) and No(N) (1 Viewer)

[r.harrison]

Slight change of thread, but thought this may be of use.

I've been searching all over for a way to customise a msgbox but there doesn't seem to be a solution. I therefore wrote my own. Hope this may be of use to someone.

I've only written in options for up to 4 buttons, but the form / code can be adapted.

First off create a form (frm_msgbox).

Add 3 Labels named txt_1, txt_2, txt_3 and format them however you wish. Change the Horizontal Anchor for all 3 to 'Both'

Now add the 4 Buttons named Button1,2,3,4 ... Set visible to False

Ensure the 3 labels meet both edges of the form

To open the msgbox form I created a second form (frm_main) and added a single button to call the funtion.

Create a new module and add this code:

Option Compare Database

Global Pressed As Integer ' Triggered when a button on the msgbox form is pressed
Global Btns(4) As Variant ' Set to the number of buttons on the msgbox form
Global nButtons As Integer ' The number of buttons in use on the msgbox form

'-----------------------------------------------------------------------------------
'Function to display the msgbox
'-----------------------------------------------------------------------------------

Public Function MsgBox(ByVal Title As String, ByVal Message1 As String, ByVal Message2 As String, ByVal Message3 As String) As Integer

    Dim Wdth, Hght, MessageLength, FormWdth As Integer

    Pressed = -1 ' Set to -1 until a button is pressed
'-----------------------------------------------------------------------------------
'Open the form and write to the labels
'-----------------------------------------------------------------------------------
    DoCmd.OpenForm "frm_msgbox"
    With Forms("frm_msgbox")
        .Caption = Title
        .txt_1.Caption = Message1
        .txt_2.Caption = Message2
        .txt_3.Caption = Message3
'-----------------------------------------------------------------------------------
'Format the width of the msgbox so all the text and buttons fit
'-----------------------------------------------------------------------------------
' Find out which line of text is the longest
        MessageLength = Len(Message1)
        If Len(Message2) > MessageLength Then MessageLength = Len(Message2)
        If Len(Message3) > MessageLength Then MessageLength = Len(Message3)
' Find out if the title of the msgbox is longer than the message
        If Len(Title) + 9 > MessageLength Then
            Wdth = (Len(.Caption) + 9) * 120
        Else
            Wdth = MessageLength * 120
        End If
' Find out if the width of the buttons is more than the width of the messages
        If Wdth < nButtons * 1200 Then Wdth = (nButtons * 1200) + 200
        Hght = 2300
        .Move (Forms("frm_msgbox").InsideWidth / 2) - (Wdth / 2), (Forms("frm_msgbox").InsideHeight / 2) - (Hght / 2), Wdth, Hght
'-----------------------------------------------------------------------------------
'Modify the buttons to fit the form
'-----------------------------------------------------------------------------------
        For a = 1 To nButtons
            FormWdth = .InsideWidth
            With .controls("Button" & a)
                .Caption = Btns(a - 1)
                '.Left = ((a - 1) * 1000) + (200 * (a))
                .Left = FormWdth - (a * 1000) - (200 * (a))
                .Width = 1000
                .Top = 1200
                .Height = 500
                .Visible = True
            End With
        Next a
    End With
'-----------------------------------------------------------------------------------
'Wait for the user to press a button
'-----------------------------------------------------------------------------------
    Do
        DoEvents
    Loop Until Pressed > -1
'-----------------------------------------------------------------------------------
'Return the value of the pressed button
'-----------------------------------------------------------------------------------
    MsgBox = Pressed

End Function

'-----------------------------------------------------------------------------------
'This function creates an array containing the buttons for the msgbox
'-----------------------------------------------------------------------------------

Public Function MsgBoxBtns(ByVal sBtn As String) As Variant

    Dim objBtns As Variant
'Split the buttons string into a variable
    objBtns = Split(sBtn, ",", 4)
    nButtons = 0
'Assign each button to the array, and count the buttons
    For Each i In objBtns
        Btns(nButtons) = i
        nButtons = nButtons + 1
    Next
    SetButtons = Btns()
    
End Function

The Button_Click on frm_msgbox events are:

Option Compare Database

'-----------------------------------------------------------------------------------
'Simple code to return which button has been pressed
'-----------------------------------------------------------------------------------

Private Sub Button1_Click()

    Pressed = 0
    DoCmd.Close
    
End Sub

Private Sub Button2_Click()

    Pressed = 1
    DoCmd.Close
    
End Sub

Private Sub Button3_Click()

    Pressed = 2
    DoCmd.Close
    
End Sub

Private Sub Button4_Click()

    Pressed = 3
    DoCmd.Close
    
End Sub

And finally the code to call the msgbox (frm_main) code:

Option Compare Database

Private Sub cmd_click_Click()

    Dim BtnPressed As String
'-----------------------------------------------------------------------------------
'Assign the button text and display the msgbox
'-----------------------------------------------------------------------------------

'Call the msgboxbtns function with a comma seperated string containing button names
    MsgBoxBtns "Button4,Button3,Button2,Button1"
'Call the msgbox function and return what button was pressed
    BtnPressed = Btns(MsgBox("Message Box Title", "Line 1 of text", "Line 2 of text", "Line 3 of text"))
'Choose what to do depending on button pressed
    Select Case BtnPressed
        Case Btns(0)
            'Some Code
        Case Btns(1)
            'Some Code
        Case Btns(2)
            'Some Code
        Case Btns(3)
            'Some Code
    End Select

    MsgBoxBtns "OK"
    MsgBox "It Works", "You Pressed a button", "The button you pressed was", "The " & BtnPressed & " Button"
    
End Sub

Hope this will be of use to someone.

 

[CBrighton]

FYI the 2nd arguement in the Msgbox function defines the buttons.

Some available options are:

vbOKOnly0Display OK button only.vbOKCancel1Display OK and Cancel buttons.vbAbortRetryIgnore2Display Abort, Retry, and Ignore buttons.vbYesNoCancel3Display Yes, No, and Cancel buttons.vbYesNo4Display Yes and No buttons.vbRetryCancel5Display Retry and Cancel buttons.vbCritical16Display Critical Message icon. vbQuestion32Display Warning Query icon.vbExclamation48Display Warning Message icon.vbInformation64Display Information Message icon.