<

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x

Modern/Metro style message box and input box for Microsoft Access 2013+

Published on
15,899 Points
7,399 Views
5 Endorsements
Last Modified:
Approved
Modern/Metro styled message box and input box that directly can replace MsgBox() and InputBox()in Microsoft Access 2013 and later.
Also included is a preconfigured error box to be used in error handling.

Background

The native message box of Microsoft Access 2013 is boring and lousy compared to the strong and clean Modern/Metro style of Windows 8+. You are probably just too familiar with the traditional message box:


MsgBox.PNG

as well as the input box:


InputBox.PNG


Wouldn't it be nice with a more attractive style that fits Windows 8 and later much better? Well, here it is:


ModBox.PNG


and likewise:


InputMox.PNG


With Microsoft Access 2013 it is possible to create a Modern/Metro look using the full-screen forms. Then the difference stands out. Here you have called:


Result = MsgBox( _
    "This will delete all entries for this plan!", _
    vbOKCancel + vbExclamation + vbDefaultButton2, _
    "Reset Plan")

and this could be the result:


AppMsgBox.PNG


This clash between styles is avoided with our Modern Box. The calling code is identical:


Result = MsgMox( _
    "This will delete all entries for this plan!", _
    vbOKCancel + vbExclamation + vbDefaultButton2, _
    "Reset Plan")

and this is the result:


AppModBox.PNG


A much better match.

 

Styling

All styling is applied when opening the form:

 

Private Sub Form_Load()

    ' Apply modern colours to form.
    Call SetColours
    ' Show specified icon.
    Call SetIcon
    
End Sub

Private Sub Form_Open(Cancel As Integer)

    ' Set the messagebox style variables.
    Call SetMsgBoxStyle
    ' Set caption of title bar.
    Call SetTitle
    ' Set prompt.
    Call SetPrompt
    ' Set active buttons and captions and taborder.
    ' Eventually resize form to accommodate buttons and a supersized prompt.
    Call SetButtonSequence
    
    ' Set default result value.
    Result = vbCancel

End Sub


The exception is the colouring of the buttons as this changes according to which button is the default:

 

Private Sub ButtonFocus(ByVal ButtonIndex As Long)
    
' Style buttons to indicate the new default button.

    ' Set (new) default button.
    Me("Button" &amp; CStr(ButtonIndex)).Default = True
    
    ' Set (new) default result value.
    Result = Buttons(ButtonIndex)(ButtonProperty.Value)
    
    ' Recolour visible buttons.
    Call StyleCommandButtons(Me)

End Sub


Public Sub StyleCommandButtons(ByRef frm As Form)

' Apply a style to all non-transparent command buttons on a form.
' 2014-10-10. Gustav Brock, Cactus Data ApS, CPH.
' Version 1.0.0
' License: MIT.

' Requires:
'   Module:
'       ModernThemeColours

' Typical usage:
'
'   Private Sub Form_Load()
'       Call StyleCommandButtons(Me)
'   End Sub

    Dim ctl                 As Control
    
    For Each ctl In frm.Controls
        If ctl.ControlType = acCommandButton Then
            If ctl.Transparent = True Then
                ' Leave transparent buttons untouched.
            Else
                ctl.Height = 454
                ctl.UseTheme = True
                If ctl.Default = True Then
                    ctl.BackColor = wpThemeColor.Cobalt
                Else
                    ctl.BackColor = ctl.Parent.Section(ctl.Section).BackColor
                End If
                ctl.HoverForeColor = ctl.BackColor
                ctl.HoverColor = wpThemeColor.White
                ctl.PressedColor = wpThemeColor.Darken
                ctl.BorderWidth = 2
                ctl.BorderStyle = 1
                ctl.BorderColor = wpThemeColor.White
                ctl.ForeColor = wpThemeColor.White
                ctl.FontName = "Segoe UI"
                ctl.FontSize = 11
                ctl.FontBold = True
                ctl.FontItalic = False
            End If
        End If
    Next
    
    Set ctl = Nothing

End Sub


The key function here is the generic StyleCommandButtons which is used throughout the application to control the style of buttons. Therefore it is placed in another module. It retrieves a colour scheme from a third module:

 

' Adoption of Windows Phone 7.5/8.0 colour theme for VBA.
' 2014-10-10. Gustav Brock, Cactus Data ApS, CPH.
' Version 1.0.0
' License: MIT.

Public Enum wpThemeColor
    ' Official colour names from WP8.
    Lime = &amp;HC4A4&amp;
    Green = &amp;H17A960
    Emerald = &amp;H8A00&amp;
    Teal = &amp;HA9AB00
    Cyan = &amp;HE2A11B
    Cobalt = &amp;HEF5000
    Indigo = &amp;HFF006A
    Violet = &amp;HFF00AA
    Pink = &amp;HD072F4
    Magenta = &amp;H7300D8
    Crimson = &amp;H2500A2
    Red = &amp;H14E5&amp;
    Orange = &amp;H68FA&amp;
    Amber = &amp;HAA3F0
    Yellow = &amp;HC8E3&amp;
    Brown = &amp;H2C5A82
    Olive = &amp;H64876D
    Steel = &amp;H87766D
    Mauve = &amp;H8A6076
    Sienna = &amp;H2D52A0
    ' Colour name aliases from WP7.5
    Viridian = &amp;HA9AB00
    Blue = &amp;HE2A11B
    Purple = &amp;HFF00AA
    Mango = &amp;H68FA&amp;
    ' Used for black in popups.
    Darken = &amp;H1D1D1D
    ' Additional must-have names for grey scale.
    Black = &amp;H0&amp;
    DarkGrey = &amp;H3F3F3F
    Grey = &amp;H7F7F7F
    LightGrey = &amp;HBFBFBF
    White = &amp;HFFFFFF
End Enum


Challenges

At first, you may think, this task basically is just to design a borderless form and open it in dialogue mode. However, if you do so, the border style of Windows is forced upon the form. Even worse, an uncontrollable title "Message" is applied:


ModerdDialog.PNG


To be honest, this is for a reason. Without this titlebar, you cannot drag the form. So, even if what you want is a dialogue form, you cannot open the form in dialogue mode, so you will have to add custom code to:

 

  • simulate the dialogue mode
  • enable dragging of the form


Other tasks to replicate the true function of MsgBox are:

 

  • enable and arrange the buttons and the icon
  • expand the form to hold four buttons
  • extend the form to hold an extended prompt
  • retrieve localized captions for the buttons
  • enable calling a help file
  • return the correct result for any mouse or key click


Further, the MsgBox can be visually right-to-left mirrored using the style constant vbMsgBoxRtlReading. This, hovewer, is not implemented in MsgMox as I have no need for this feature. Other style constants are also ignored - vbApplicationModal, vbMsgBoxSetForeground, vbSystemModal - as these have little or no impact in Windows 8+.


The input box is simpler as neither the buttons nor an icon can be controlled. The Help button is displayed only if both helpfile and content are specified. The major difference is that the opening position of the form can be specified relative to the top-left screen corner. This has little or no use with the larger screens used today, so this option has been modified to set the position relative to the application window. If left out, the form is centered relative to the application window.


InputMoxHelp.PNG


Finally, wrapper functions must be created to act as a direct replacement for MsgBox and InputBox. This way, the Modern/Metro boxes can be implemented by a simple find/replace requiring zero rewriting of the code.

 

Simulating dialogue mode

This has been implemented by running an endless loop after the form has been opened. The main issue here is to find a sleep time that does not load the CPU while offering fast exit from the loop:

 

' API call for sleep function.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Public Function OpenFormDialog( _
    ByVal FormName As String, _
    Optional ByVal TimeOut As Long, _
    Optional ByVal OpenArgs As Variant = Null) _
    As Boolean
    
' Open a modal form in non-dialogue mode to prevent dialogue borders to be displayed
' while simulating dialogue behaviour using Sleep.

' If TimeOut is negative, zero, or missing:
'   Form FormName waits forever.
' If TimeOut is positive:
'   Form FormName exits after TimeOut milliseconds.
    
    Const SecondsPerDay     As Single = 86400
    
    Dim LaunchTime          As Date
    Dim CurrentTime         As Date
    Dim TimedOut            As Boolean
    Dim Index               As Integer
    Dim FormExists          As Boolean
    
    ' Check that form FormName exists.
    For Index = 0 To CurrentProject.AllForms.Count - 1
        If CurrentProject.AllForms(Index).Name = FormName Then
            FormExists = True
            Exit For
        End If
    Next
    If FormExists = True Then
        If CurrentProject.AllForms(FormName).IsLoaded = True Then
            ' Don't reopen the form should it already be loaded.
        Else
            ' Open modal form in non-dialogue mode to prevent dialogue borders to be displayed.
            DoCmd.OpenForm FormName, acNormal, , , , acWindowNormal, OpenArgs
        End If
        ' Record launch time and current time with 1/18 second resolution.
        LaunchTime = Date + CDate(Timer / SecondsPerDay)
        Do While CurrentProject.AllForms(FormName).IsLoaded
            ' Form FormName is open.
            ' Make sure form and form actions are rendered.
            DoEvents
            ' Halt Access for 1/20 second.
            ' This will typically cause a CPU load less than 1%.
            ' Looping faster will raise CPU load dramatically.
            Sleep 50
            If TimeOut > 0 Then
                ' Check for time-out.
                CurrentTime = Date + CDate(Timer / SecondsPerDay)
                If (CurrentTime - LaunchTime) * SecondsPerDay > TimeOut / 1000 Then
                    ' Time-out reached.
                    ' Close form FormName and exit.
                    DoCmd.Close acForm, FormName, acSaveNo
                    TimedOut = True
                    Exit Do
                End If
            End If
        Loop
        ' At this point, user or time-out has closed form FormName.
    End If
    
    ' Return True if the form was not found or was closed by user interaction.
    OpenFormDialog = Not TimedOut

End Function

Study the in-line comments for details.


Enable dragging of the form

One function inside the forms handles this:

 

' Parameters for mouse action.
Private Enum MouseAction
    MouseDown = 1
    MouseMove = 0
    MouseUp = -1
End Enum


Private Sub FormMove(Button As Integer, Shift As Integer, X As Single, Y As Single, _
    ByVal MouseAction As MouseAction)

' Move the form by dragging the title bar or the label upon it.

    ' Statics to hold the position of the form when mouse is clicked.
    Static PositionX        As Single
    Static PositionY        As Single
    ' Static to hold that a form move is enabled.
    Static MoveEnabled      As Boolean
    
    Dim WindowTop           As Single
    Dim WindowLeft          As Single
    
    ' The value of MoveEnable indicates if the call is from
    ' mouse up, mouse down, or mouse move.
    
    If MouseAction = MouseMove Then
        ' Move form.
        If MoveEnabled = True Then
            ' Form move in progress.
            If Button = acLeftButton Then
                ' Calculate new form position.
                WindowTop = Me.WindowTop + Y - PositionY
                WindowLeft = Me.WindowLeft + X - PositionX
                ' Reposition form.
                Me.Move WindowLeft, WindowTop
            End If
        End If
    Else
        ' Enable/disable form move.
        If Button = acLeftButton Then
            ' Only left-button click accepted.
            'If MoveEnable = True Then
            If MouseAction = MouseDown Then
                ' MouseDown.
                ' Store cursor start position.
                PositionX = X
                PositionY = Y
                MoveEnabled = True
            Else
                ' MouseUp.
                ' Stop form move.
                MoveEnabled = False
            End If
        End If
    End If

End Sub


Armed with this, the mouse actions control if we can drag the form:

 

Private Sub LabelTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' Enable dragging of the form.
    Call FormMove(Button, Shift, X, Y, MouseDown)

End Sub

Private Sub LabelTitle_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' Drag the form if dragging is enabled.
    Call FormMove(Button, Shift, X, Y, MouseMove)

End Sub

Private Sub LabelTitle_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' Disable dragging of the form.
    Call FormMove(Button, Shift, X, Y, MouseUp)

End Sub



Button sequence and form resizing 

Setting the button sequence in the message box is a bit more complicated than you may think. Some exclude the normal Cancel button of the form itself or the captions changes, and a Help button can be added. This is solved by stacking four buttons on first position, then repositioning these as needed. The main function is this:

 

Private Sub SetButtonSequence()

' Arrange from one to four visible buttons and refresh their captions.

    ' Maximum count of enabled (visible) buttons including Help button.
    Const MaxButtonCount    As Long = 3 + 1
    ' First button index.
    Const FirstButton       As Long = 0
    ' Undefined result value for Help button and inactive buttons.
    Const MsgBoxResultNone  As Long = 0
    
    Dim WindowWidth         As Long
    Dim WindowExpand        As Long
    Dim WindowExtend        As Long
    Dim ActiveButtonCount   As Long
    Dim HelpButtonCount     As ButtonCount
    Dim ButtonIndex         As Long
    Dim NoCancel            As Boolean
    Dim LineCount           As Integer
    
    ' Fill array of localized captions.
    Call FillCaptions
    ' Fill array of button positions.
    Call FillPositions
    
    If HelpButton = vbMsgBoxHelpButton Then
        ' The Help button shall be displayed.
        HelpButtonCount = ButtonCount.Help
    End If
    
    ' Set captions and return values on active (visible) buttons.
    Select Case ButtonSequence
        Case vbAbortRetryIgnore
            ActiveButtonCount = ButtonCount.AbortRetryIgnore
            Buttons(FirstButton) = Array(True, Captions(ButtonCaption.ButtonAbort), VbMsgBoxResult.vbAbort)
            Buttons(FirstButton + 1) = Array(True, Captions(ButtonCaption.ButtonRetry), VbMsgBoxResult.vbRetry)
            Buttons(FirstButton + 2) = Array(True, Captions(ButtonCaption.ButtonIgnore), VbMsgBoxResult.vbIgnore)
            NoCancel = True
        Case vbOKCancel
            ActiveButtonCount = ButtonCount.OKCancel
            Buttons(FirstButton) = Array(True, Captions(ButtonCaption.ButtonOK), VbMsgBoxResult.vbOK)
            Buttons(FirstButton + 1) = Array(True, Captions(ButtonCaption.ButtonCancel), VbMsgBoxResult.vbCancel)
        Case vbOKOnly
            ' Note: Any click action (except Help) will result in Cancel.
            ActiveButtonCount = ButtonCount.OKOnly
            Buttons(FirstButton) = Array(True, Captions(ButtonCaption.ButtonOK), VbMsgBoxResult.vbCancel)
        Case vbRetryCancel
            ActiveButtonCount = ButtonCount.RetryCancel
            Buttons(FirstButton) = Array(True, Captions(ButtonCaption.ButtonTryAgain), VbMsgBoxResult.vbRetry)
            Buttons(FirstButton + 1) = Array(True, Captions(ButtonCaption.ButtonCancel), VbMsgBoxResult.vbCancel)
        Case vbYesNo
            ActiveButtonCount = ButtonCount.YesNo
            Buttons(FirstButton) = Array(True, Captions(ButtonCaption.ButtonYes), VbMsgBoxResult.vbYes)
            Buttons(FirstButton + 1) = Array(True, Captions(ButtonCaption.ButtonNo), VbMsgBoxResult.vbNo)
            NoCancel = True
        Case vbYesNoCancel
            ActiveButtonCount = ButtonCount.YesNoCancel
            Buttons(FirstButton) = Array(True, Captions(ButtonCaption.ButtonYes), VbMsgBoxResult.vbYes)
            Buttons(FirstButton + 1) = Array(True, Captions(ButtonCaption.ButtonNo), VbMsgBoxResult.vbNo)
            Buttons(FirstButton + 2) = Array(True, Captions(ButtonCaption.ButtonCancel), VbMsgBoxResult.vbCancel)
        Case Else
            ' Identical to OKOnly.
            ' Note: Any click action (except Help) will result in Cancel.
            ActiveButtonCount = ButtonCount.OKOnly
            Buttons(FirstButton) = Array(True, Captions(ButtonCaption.ButtonOK), VbMsgBoxResult.vbCancel)
    End Select
    
    ' Add a Help button at far right if requested.
    If HelpButtonCount = 1 Then
        HelpButtonIndex = ActiveButtonCount
        Buttons(HelpButtonIndex) = Array(True, Captions(ButtonCaption.ButtonHelp), MsgBoxResultNone)
        ActiveButtonCount = ActiveButtonCount + HelpButtonCount
    End If
    ' Reset remaining buttons.
    For ButtonIndex = ActiveButtonCount To MaxButtonCount - 1
        Buttons(ButtonIndex) = Array(False, vbNullString, MsgBoxResultNone)
    Next
    ' Set display status for all buttons.
    For ButtonIndex = FirstButton To MaxButtonCount - 1
        With Me("Button" &amp; CStr(ButtonIndex))
            .Visible = Buttons(ButtonIndex)(ButtonProperty.Visible)
            .Caption = Buttons(ButtonIndex)(ButtonProperty.Caption)
        End With
    Next
    
    ' Expand the form to make room for multiple buttons.
    WindowExpand = Positions(ActiveButtonCount - 1) - Positions(FirstButton)
    WindowWidth = Me.WindowWidth + WindowExpand
    Me.Move Me.WindowLeft, Me.WindowTop, WindowWidth
   
    ' Remove form's close button for certain button combinations.
    If NoCancel = True Then
        Me!ButtonCancel.Enabled = False
        Me!PictureClose.Visible = False
    Else
        ' Reposition Cancel button and form's close button (picture).
        Me!ButtonCancel.Left = Me!ButtonCancel.Left + WindowExpand
        Me!PictureClose.Left = Me!PictureClose.Left + WindowExpand
    End If
    
    ' Extend the form fit a supersized prompt.
    LineCount = PromptLineCount()
    If LineCount > 0 Then
        ' Extend the form and controls (except buttons) to
        ' make room for multiple prompt lines.
        WindowExtend = FormExtend(LineCount)
    End If
    ' Position active buttons.
    For ButtonIndex = FirstButton To ActiveButtonCount - 1
        With Me("Button" &amp; CStr(ButtonIndex))
            .Left = Positions(ButtonIndex)
            .Top = .Top + WindowExtend
        End With
    Next
    
    ' Apply tab settings.
    Call SetDefaultButton
    
End Sub


You will notice the extensive use of arrays for holding the buttons and their properties, and that the form is expanded and extended as needed. Here is an example:


ModBoxLarge.PNG



Localized captions

Notice the localized captions above. These are pulled from user32.dll with a few API calls:

 

' API functions for retrieval of localized button captions.
Private Declare Function LoadString Lib "user32" Alias "LoadStringA" ( _
    ByVal hInstance As Long, _
    ByVal wID As Long, _
    ByVal lpBuffer As String, _
    ByVal nBufferMax As Long) _
    As Long
         
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( _
    ByVal lpFileName As String) _
    As Long

Private Sub FillCaptions()

' Retrieve localized button captions into array Captions.

    Const FileName          As String = "user32.dll"
    Const BufferMax         As Long = 256
    
    Dim Buffer              As String
    Dim StringLength        As Long
    Dim Instance            As Long
    Dim CaptionId           As Long
    
    Instance = LoadLibrary(FileName)

    ' Read localized captions into static array.
    For CaptionId = FirstCaptionId To LastCaptionId
        Buffer = String(BufferMax, vbNullChar)
        StringLength = LoadString(Instance, CaptionId, Buffer, BufferMax)
        Captions(CaptionId) = Left(Buffer, StringLength)
    Next

End Sub



Calling a help file

Though hardly used very often, this feature is implemented. In version 1.2.0, all the code related to the API call has been moved to a separate module, HtmlHelp, as it can be used separately, and to not clutter the ModernBox module. 

What's left is a set of simple functions to open and close the Help Viewer:

 

' Open a help file at context ContextID if found.
'
' Note:
'   An opened help viewer window must be closed before exiting the application,
'   or, most likely, Access will chrash.
'
' Requires:
'   HtmlHelp
'
' 2018-04-26. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function OpenHelp( _
    ByVal HelpFile As String, _
    Optional ByVal ContextID As Long = 1) _
    As Boolean
   
    Const MinimumContextID  As Long = 1
   
    Dim Success             As Boolean
    ' Adjust invalid context IDs.
    If ContextID < MinimumContextID Then
        ContextID = MinimumContextID
    End If
   
    ' Open help file.
    ' Fails silently if help file or context ID is not found.
    Success = HelpControl(OpenContext, HelpFile, ContextID)
   
    OpenHelp = Success
   
End Function
' Close all open HTML Help Viewer windows.
'
' Requires:
'   HtmlHelp
'
' 2018-04-26. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CloseHelp() As Boolean
   
    Dim Success             As Boolean
   
    ' Close help file.
    ' Fails silently if no Help Viewer windows are open.
    Success = HelpControl(CloseAll)
   
    CloseHelp = Success
   
End Function



Return the result

The message result to return is preset every time a button gains focus:

 

Private Sub ButtonFocus(ByVal ButtonIndex As Long)
    
' Style buttons to indicate the new default button.

    ' Set (new) default button.
    Me("Button" &amp; CStr(ButtonIndex)).Default = True
    
    ' Set (new) default result value.
    Result = Buttons(ButtonIndex)(ButtonProperty.Value)
    
    ' Recolour visible buttons.
    Call StyleCommandButtons(Me)

End Sub


and at the same time the buttons are recoloured to indicate which button now is the default button.


The input box simply returns the typed in string to the global variable mbInputText if OK is clicked, or an empty string if Cancel is clicked.

 

Wrapping it all up

As mentioned earlier, the forms are controlled by functions, MsgMox and InputMox, very similar to MsgBox and InputBox:

 

' Global variables for forms ModernBox and ModputBox.
Public mbPrompt             As String
Public mbTitle              As Variant
Public mbHelpFile           As String
Public mbContext            As Long
' Global variables for form ModernBox.
Public mbButtons            As VbMsgBoxStyle
' Global variables for form ModputBox.
Public mbDefault            As String
Public mbXPos               As Variant
Public mbYPos               As Variant

' Global variable set by form ModernBox when closed.
Public mbResult             As VbMsgBoxResult
' Global variable set by form ModputBox when closed.
Public mbInputText          As String

' Form name of the modern message box.
Private Const ModernBoxName As String = "ModernBox"
' Form name of the modern input box.
Private Const ModputBoxName As String = "ModputBox"


Public Function MsgMox( _
    Prompt As String, _
    Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
    Optional Title As Variant = Null, _
    Optional HelpFile As String, _
    Optional Context As Long, _
    Optional TimeOut As Long) _
    As VbMsgBoxResult
    
' Syntax. As for MsgBox with an added parameter, TimeOut:
' MsgMox(Prompt, [Buttons As VbMsgBoxStyle = vbOKOnly], [Title], [HelpFile], [Context], [TimeOut]) As VbMsgBoxResult
'
' If TimeOut is negative, zero, or missing:
'   MsgMox waits forever as MsgBox.
' If TimeOut is positive:
'   MsgMox exits after TimeOut milliseconds, returning the result of the current default button.
    
    ' Set global variables to be read by form ModernBox.
    mbButtons = Buttons
    mbPrompt = Prompt
    mbTitle = Title
    mbHelpFile = HelpFile
    mbContext = Context
    
    Call OpenFormDialog(ModernBoxName, TimeOut)
    
    ' Return result value set by form ModernBoxName.
    MsgMox = mbResult

End Function


Public Function InputMox( _
    Prompt As String, _
    Optional Title As Variant = Null, _
    Optional Default As String, _
    Optional XPos As Variant = Null, _
    Optional YPos As Variant = Null, _
    Optional HelpFile As String, _
    Optional Context As Long, _
    Optional TimeOut As Long) _
    As String
    
' Syntax. As for InputBox with an added parameter, TimeOut:
' InputMox(Prompt, [Title], [Default], [XPos], [YPos], [HelpFile], [Context], [TimeOut]) As VbMsgBoxResult
'
' Note:
'   XPos and YPos are relative to the top-left corner of the
'   application, not the screen as it is for InputBox.
'
' If TimeOut is negative, zero, or missing:
'   InputMox waits forever as InputBox.
' If TimeOut is positive:
'   InputMox exits after TimeOut milliseconds, returning an empty string.
    
    ' Set global variables to be read by form ModernBox.
    mbPrompt = Prompt
    mbTitle = Title
    mbDefault = Default
    mbXPos = XPos
    mbYPos = YPos
    mbHelpFile = HelpFile
    mbContext = Context
    
    Call OpenFormDialog(ModputBoxName, TimeOut)
    
    ' Return return value set by form ModputBoxName.
    InputMox = mbInputText

End Function


When opened, the form reads the global variables that control its behaviour and, when closing, it returns the result in another global variable, mbResult or mbInputText, that then is returned by the function.


You will notice that one feature compared to MsgBox and InputBox has been added: A timeout. This can be useful for unattended operation or other situations where you don't want the application to hang waiting for a user interaction.

 

Error box ready to use

If you provide friendly error handling with error code and description for the user to report, you may take advantage of the function ErrorMox which wrap MsgMox so you can display useful error information with just about zero additional code:


Public Function ErrorMox( _
    Optional ByVal Topic As String) _
    As String

' Opens a MsgMox predefined for displaying the error number, source, and description if Err <> 0.
' Also reestablishes the application window if Echo is False, the cursor if Hourglass is True,
' and resets the Status line.

    ' Text to prefix the error number.
    Const Prefix    As String = "Error"
    
    Dim Prompt      As String
    Dim Title       As String
    Dim Buttons     As VbMsgBoxStyle
    Dim Message     As String
    
    If Err = 0 Then
        ' No error. Exit.
    Else
        ' Reestablish display.
        DoCmd.Hourglass False
        DoCmd.Echo True
        
        ' Display error message.
        Title = ApplicationTitle
        Title = Title &amp; ": " &amp; Application.CurrentObjectName
        If Topic <> "" Then
            Title = Title &amp; ", " &amp; Topic
        End If
        
        If Prefix <> "" Then
            Prompt = Prefix &amp; ": "
        End If
        Prompt = Prompt &amp; CStr(Err.Number) &amp; vbCrLf &amp; _
            Err.Description &amp; "."
        
        Buttons = vbOKOnly + vbCritical
        MsgMox Prompt, Buttons, Title
        
        ' Clear status line.
        StatusLineReset
        
        ' Return message lines.
        Message = Title &amp; vbCrLf &amp; Prompt
    End If
    
    ErrorMox = Message

End Function

As you can see, it takes info from the Err object and formats these and finish it up with the title of the application.

The project for download contains a tiny demo to demonstrate this, and this is the result:


ErrorMox.PNG 

Code

The complete ModernBox project consists of two forms and four modules which can be copy/pasted into any application.

It has been tested in Access 2013/2016 32-bit and 64-bit under Windows 8.1/10.


From version 1.1 also a collection of helper functions for the colour theme is included.

 

Project download, Access 2016: ModernBox 1.2.0.zip
Also, always the newest version at GitHub: VBA.ModernBox


ModBoxThankyou.PNG


Feel free to leave a comment.

5
  • 9
  • 3
  • 3
  • +2
18 Comments
LVL 56

Author Comment

by:Gustav Brock
Version 1.0.1 uploaded.
Displays prompts containing "&" literally instead of replacing "&"with an underline of the next character.

/gustav
0
LVL 56

Author Comment

by:Gustav Brock
No problem.
Have a nice weekend!

/gustav
0
LVL 2

Expert Comment

by:Peter Cole
Very impressive.
For easy implementation  in existing db's try changing msgmox to msgbox   in 3 places in the module.
Access uses your code rather than the internal msgbox.

In addition to using windows colors it is possible to use Access Theme colors so that the msgbox will adjust to match the db.
Attached is a modified version. For those unfamiliar with themes add the theme gallery to the quick Access Toolbar

Add Access Theme Gallery to Quick Access
0
Active Protection takes the fight to cryptojacking

While there were several headline-grabbing ransomware attacks during in 2017, another big threat started appearing at the same time that didn’t get the same coverage – illicit cryptomining.

LVL 2

Expert Comment

by:Peter Cole
To try open form1 and click the button and  two samples of the MsgBox will show.  Selecting a different Theme from the gallery  and clicking the button again will show the boxes with the new colors.
The relative intensities of the colors can be adjusted in the form property sheet by adjusting the Lighter or Darker percentages.
Regards
Peter
0
LVL 56

Author Comment

by:Gustav Brock
Thanks Peter for the hints,
But I see no attachment.

/gustav
0
LVL 2

Expert Comment

by:Peter Cole
Sorry missed the upload.
Hope this helps.
ModernBox_Themed.zip
0
LVL 56

Author Comment

by:Gustav Brock
Thanks Peter

Yes, you can rename the function to MsgBox and you can still call the native MsgBox with VBA.MsgBox.
But my feeling is that will add confusion for many so I decided to stick with a custom name.

As for the colours, you can select any colour or theme you like, but the purpose with the article is to demonstrate a practical use of the vivid colours of the Windows Phone Theme palette.

By the way, I have an upcoming article on this:

Create Windows Phone Colour Palette and Selector using WithEvents

but it hasn't been approved yet, so the link may be dead until then.

/gustav
0

Expert Comment

by:Sam Isaacson
Could you perhaps provide a sample working demo of the above in Excel - I have copied the code modules into VBA and updated for 64 bit but it is still giving me an error relating to "CurrentProject" when I try and call:

ModernBox.MsgMox "Hello World"


Thanks
Sam
0
LVL 56

Author Comment

by:Gustav Brock
Is that the 64-bit code you can find on GitHub?

I haven't Office running in 64-bit, so I have only 32-bit code running.

/gustav
0

Expert Comment

by:Sam Isaacson
I did download the code from Github to test it out and imported each file into Excel VBE. I don't have a problem making the necessary adjustments to get it working on 64 bit (just a few declare statements) but am having a problem (I think) with the MS Access specific objects causing errors in Excel VBA.

If you have a 32 bit Excel file working I would be very curious to see it.

Kind Regards
Sam
0
LVL 56

Author Comment

by:Gustav Brock
My apologies. The reference to Excel is a left-over from my article about the Windows Phone colour palette.

I did have an Excel version in mind, I recall now, but I found that (user)forms in Excel is quite a different animal than forms in Access.
Somehow a userform in Excel could be tweaked for the purpose, I guess, but I have never designed a form in Excel, so it wouldn't be a 15 minute task for me, thus I had to postpone the task and haven't yet found the time.

I'll put it on my to-do list but can't tell when done. If I succeed, I'll drop a message here, of course.

/gustav
0

Expert Comment

by:Sam Isaacson
Cool - thanks.
0

Expert Comment

by:Erin Brophy
Hi,

I'm trying to use you're example to format my entire database, starting with my splash page and going from there.

I'm having trouble with the FormMove Sub. When I try to compile, I get an error message that says "user-defined type not defined" and points to the line:

Private Sub FormMove(Button As Integer, Shift As Integer, X As Single, Y As Single, _
    ByVal MouseAction As MouseAction)

Please help! I'm fairly new at this.

Thanks!
0
LVL 56

Author Comment

by:Gustav Brock
If my demo runs at you, that kind of error typically indicates a missing reference.
Go to menu Tools, References and check if any reference is marked MISSING. If so, correct that.
0

Expert Comment

by:Tech BUD
MetroMessageBox click event minimize the active forms in c#.
In my application i used to work with multiple form(Metro) and when i get a messageBox click event minimize the other forms except the form which generates messageBox.
How can i fix this???
0
LVL 56

Author Comment

by:Gustav Brock
C#? I'm not sure I follow.

The project here is in VBA (Visual Basic for Applications) which is not related to C#.
0

Expert Comment

by:Tech BUD
Here u have discussed about Metro framework...Can u tell me the soln n VBA????
0
LVL 56

Author Comment

by:Gustav Brock
It's not about the framework. It's about applying a message box and an input box in VBA (Microsoft Access) a design that mimics and matches that of Windows 8.x.
0

Featured Post

OWASP: Threats Fundamentals

Learn the top ten threats that are present in modern web-application development and how to protect your business from them.

Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month