Can you format MsgBox text?

[TAPS_MikeDion]

Hi all,
I'm sure there must be a way to dimension a string and format it for use in a MsgBox, but I have no clue how to do the initial formatting; any help would be GREATLY appreciated.

FYI - something along the lines of...

Dim S as String
S = "This part of the string is bold and italicized, and this part is not"
MsgBox S, vbInformation, "My Title"

Thanks,
Mike
P.S. If this actually is possible, can you also change the color of the text?

 

[James006]

Thanks Again ...

By the way ...what are the values to revert to the ' Standard Standard MsgBox ' ...

Cheers

 

[Jaafar Tribak]

Thanks Again ...

By the way ...what are the values to revert to the ' Standard Standard MsgBox ' ...

Cheers

The MsgBoxEx function writes the default settings of the standard Msgbox to a text file created in the workbook folder so you can recover them should an unexpected error occur before restoring the NONCLIENTMETRICS default settings.

In my computer, the standard Msgbox Font name is "Segoe UI" and its size is 12.

If you want to see all the default NONCLIENTMETRICS settings in debug window it is rather convultated as they are stored in UDTs within a UDT but can be done.

To see just the standard msgbox Font name and size you could just add the following lines in red :

Private Function MsgBoxEx( _ 
   ByVal Prompt As String, _
    Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
    Optional ByVal Title As String, _
    Optional ByVal HelpFile As String, _
    Optional ByVal Context As Long, _
    Optional ByVal FontName As String, _
    Optional ByVal FontSize As Single, _
    Optional ByVal FontBold As Boolean, _
    Optional ByVal FontItalic As Boolean, _
    Optional ByVal FontUnderline As Boolean, _
    Optional ByVal FontStrikeOut As Boolean _
) As VbMsgBoxResult

    Dim tDefNCMetrics As NONCLIENTMETRICS, tNCMetrics As NONCLIENTMETRICS, tLogFont As LOGFONT

    On Error GoTo ErrHandler

    tNCMetrics.cbSize = Len(tNCMetrics)
    Call SystemParametersInfo(SPI_GETNONCLIENTMETRICS, Len(tNCMetrics), tNCMetrics, 0)
    tDefNCMetrics = tNCMetrics
    
[B][COLOR=#ff0000]    Debug.Print "FontName:  "; tNCMetrics.lfMessageFont.lfFaceName[/COLOR][/B]
[COLOR=#ff0000][B]    Debug.Print "FontSize:  "; tNCMetrics.lfMessageFont.lfHeight[/B][/COLOR]
    
[B][COLOR=#008000]    'Safety step : Save to text file In case an error occurs and the default NONCLIENTMETRICS are lost.[/COLOR][/B]
[B][COLOR=#008000]    'To recover the default NONCLIENTMETRICS, run the 'RestoreDefaultNCMetrics' routine located below.[/COLOR][/B]
    Open ThisWorkbook.Path & Application.PathSeparator & "DefNCMetrics.txt" For Binary As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1"]#1[/URL] 
        Put [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1"]#1[/URL] , , tDefNCMetrics
    Close [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1"]#1[/URL] 
    
    With tLogFont
        .lfFaceName = IIf(Len(FontName), FontName & Chr$(0), tDefNCMetrics.lfMessageFont.lfFaceName & Chr$(0))
        .lfHeight = IIf(FontSize, -FontSize, tDefNCMetrics.lfMessageFont.lfHeight)
        .lfWeight = IIf(FontBold, 900, tDefNCMetrics.lfMessageFont.lfWeight)
        .lfItalic = IIf(FontItalic, True, tDefNCMetrics.lfMessageFont.lfItalic)
        .lfUnderline = IIf(FontUnderline, True, tDefNCMetrics.lfMessageFont.lfUnderline)
        .lfStrikeOut = IIf(FontStrikeOut, True, tDefNCMetrics.lfMessageFont.lfStrikeOut)
    End With

    hFont = CreateFontIndirect(tLogFont)
    tNCMetrics.lfMessageFont = tLogFont
    Call SystemParametersInfo(SPI_SETNONCLIENTMETRICS, Len(tNCMetrics), tNCMetrics, SPIF_UPDATEINIFILE)

    MsgBox Prompt, Buttons, IIf(Len(Title), Title, Application.Name), HelpFile, Context

ErrHandler:

    DeleteObject hFont
    Call SystemParametersInfo(SPI_SETNONCLIENTMETRICS, Len(tDefNCMetrics), tDefNCMetrics, SPIF_UPDATEINIFILE)
    
    If Err.Number = 75 Then
        MsgBox "Oops!" & vbCr & vbCr & "This workbook must be saved to disk" & vbCr & "before running the code.", vbInformation
    End If
End Function

 

[James006]

Just tried to run RestoreDefaultNCMetrics ...

And, for an unknown reason ... the DefNCMetrics.txt file seems empty ...

and the Debug.Print "FontName: " is empty

and the Debug.Print "FontSize: " shows 0

???

 

[Jaafar Tribak]

Just tried to run RestoreDefaultNCMetrics ...

And, for an unknown reason ... the DefNCMetrics.txt file seems empty ...

and the Debug.Print "FontName: " is empty

and the Debug.Print "FontSize: " shows 0

???

When you run the Test_MsgBoxEx macro, do you get the formatted Msgbox as shown in my original post ?

 

[James006]

When you run the Test_MsgBoxEx macro, do you get the formatted Msgbox as shown in my original post ?

No ...

The Test_MsgBoxEx macro ... produces the exact same MsgBox as the second macro : Test_Standard_MsgBox ...

Edit:

By the way ... my Chrome browser has also inherited of the Font : Bradley Hand ITC ... with a Huge Size : 32 ... !!!

 

[Jaafar Tribak]

No ...

The Test_MsgBoxEx macro ... produces the exact same MsgBox as the second macro : Test_Standard_MsgBox ...

Ok.

I am not sure why it doesn't work for you. Maybe the code is OS/office version dependent ... I 'll be testing the code on another machine sometime later and see if I can reproduce the problem.

 

[James006]

Thanks a lot for your kind assistance ...

Forgot to tell you ... your Private Inbox is full and does not accept any messages any more ...

 

[Jaafar Tribak]

No ...

Edit:

By the way ... my Chrome browser has also inherited of the Font : Bradley Hand ITC ... with a Huge Size : 32 ... !!!

That sounds like a serious issue ! Can you do a system restore on your machine ?

I am terribly sorry for causing this unwanted trouble.