Can you format MsgBox text?

TAPS_MikeDion

TAPS_MikeDion

Well-known Member
Joined
Aug 14, 2009
Messages
622
Office Version
  1. 2011
Platform
  1. MacOS
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?
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
AFAIK you can't format a messagebox. Even working with a userform the font formating options are limited to formating the elements on the userform, but not parts of strings displayed as captions or values directly. The only way I could see around that is the to make a blank userform with the necessary amount of buttons and add a properly formated label on the fly for each word in your string.
 
Upvote 0
Hmm....well that stinks.

This is the string I was trying to work with:

Message = "Adobe Reader - Meriden PDF File" & vbLf & "1) After opening the MANIFEST.pdf file from Meriden, hit CTRL+END and then hit the UP arrow." & vbLf & "2) From the menu bar: select EDIT, then SELECT ALL, select EDIT again and then select COPY." & vbLf & vbLf & "Microsoft Excel - Meriden Trip Sheets" & vbLf & "3) Select the MANIFEST.TXT sheet: Right click cell A1 and select PASTE." & vbLf & "4) Select the MAIL sheet: Type in the Mail total, hit enter and click INSERT TOTALS." & vbLf & vbLf & "Note: If using the 2 skid option, make sure you select it before printing the sheets."

I was trying to make the following pieces of the string bold and italicized "Adobe Reader - Meriden PDF File" & "Microsoft Excel - Meriden Trip Sheets."

Does everyone agree that this cannot be done?

Thank you,
Mike
 
Upvote 0
This got me curious so i started experimenting with some window subclassing and i did manage to format (Bold) a portion of the text of a standard MsgBox .

here is a workbook example.

You call the custom msgbox Function (FormatMsgBox) as follows, where the first parameter holds the text prompt and the second holds the portion of the prompt text to be formatted Bold.


Code: 
[COLOR=seagreen][B]'DEMO: [/B][/COLOR][COLOR=seagreen][B]\\\\\\\\\\\\\\\[/B][/COLOR]
[B][COLOR=seagreen]'=====================[/COLOR][/B]
Sub Test()
 
    FormatMsgBox _
    Prompt:="This text is normal." _
    & "  This text is bold.  This text is normal.", _
    BoldPart:="This text is bold.", Title:="Test1"
 
    FormatMsgBox _
    Prompt:="The first 3 characters of this line are bold.", _
    BoldPart:="The", Title:="Test2"
 
    FormatMsgBox _
    Prompt:="The last 5 characters of this line are bold.", _
    BoldPart:="bold.", Title:="Test3"
 
    FormatMsgBox _
    Prompt:="Here is a some normal Text.", Title:="Test4"
 
End Sub


Here is the code behind the FormatMsgBox : (To be placed in a Standard Module)


Code: 
Option Explicit
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As String * 1
    lfUnderline As String * 1
    lfStrikeOut As String * 1
    lfCharSet As String * 1
    lfOutPrecision As String * 1
    lfClipPrecision As String * 1
    lfQuality As String * 1
    lfPitchAndFamily As String * 1
    lfFaceName As String * 32
End Type
 
Private Declare Function CreateFontIndirect Lib "gdi32" _
Alias "CreateFontIndirectA" _
(lpLogFont As LOGFONT) As Long
 
Private Declare Function GetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" _
(ByVal hdc As Long, _
ByVal lpsz As String, _
ByVal cbString As Long, _
lpSize As POINTAPI) As Long
 
Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
 
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, _
ByVal hdc As Long) As Long
 
Private Declare Function TextOut Lib "gdi32" _
Alias "TextOutA" _
(ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal lpString As String, _
ByVal nCount As Long) As Long
 
Private Declare Function SetBkMode Lib "gdi32" _
(ByVal hdc As Long, _
ByVal nBkMode As Long) As Long
 
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, _
ByVal hObject As Long) As Long
 
Private Declare Function GetClientRect Lib "user32.dll" _
(ByVal hwnd As Long, _
ByRef lpRect As RECT) As Long
 
Private Declare Function FindWindowEx Lib "user32.dll" _
Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
 
Private Declare Function SetWindowsHookEx Lib _
"user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
 
Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long
 
Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, _
ByVal ncode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
 
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
 
Private Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
Private Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hwnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
 
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
 
Private Declare Function ShowWindow Lib "user32.dll" _
(ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
 
Private Declare Function SetTextAlign Lib "gdi32.dll" _
(ByVal hdc As Long, _
ByVal wFlags As Long) As Long
 
Private Const TA_BASELINE As Long = 24
Private Const GWL_WNDPROC As Long = -4
Private Const WH_CBT As Long = 5
Private Const HCBT_ACTIVATE As Long = 5
Private Const WM_PARENTNOTIFY As Long = &H210
Private Const WM_ACTIVATE As Long = &H6
Private Const WM_PAINT As Long = &HF&
 
Private lPrevWnd As Long
Private lhHook As Long
Private bHookEnabled As Boolean
Private sBoldPart As String
Private sPrompt As String
 
Private Sub StartHook()
 
    [COLOR=seagreen][B]'install a cbt hook to monitor for[/B][/COLOR]
[B][COLOR=seagreen]   'the activation of a window.[/COLOR][/B]
    If Not bHookEnabled Then
        lhHook = SetWindowsHookEx _
        (WH_CBT, AddressOf HookProc, 0, GetCurrentThreadId)
        bHookEnabled = True
    Else
        MsgBox "The hook is already set.", vbInformation
    End If
 
End Sub
 
Private Sub TerminateHook()
 
   [COLOR=seagreen][B]'important to unhook when done![/B][/COLOR]
    UnhookWindowsHookEx lhHook
    bHookEnabled = False
 
End Sub
 
Private Function HookProc _
(ByVal idHook As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
 
    Dim sBuffer As String
    Dim lRetVal As Long
 
   [COLOR=seagreen][B]'check if a window has been activated.[/B][/COLOR]
    If idHook = HCBT_ACTIVATE Then
 
       [COLOR=seagreen][B]'if so,get it's class name.[/B][/COLOR]
        sBuffer = Space(256)
        lRetVal = GetClassName(wParam, sBuffer, 256)
 
       [COLOR=seagreen][B]'check if it is a "MsgBox" window that is being activated.[/B][/COLOR]
        If Left(sBuffer, lRetVal) = "#32770" Then
 
           [B][COLOR=seagreen]'if so,subclass it to catch the[/COLOR][/B]
[B][COLOR=seagreen]           'WM_ACTIVATE and WM_PAINT msgs.[/COLOR][/B]
            lPrevWnd = SetWindowLong _
            (wParam, GWL_WNDPROC, AddressOf CallBackProc)
 
            [COLOR=seagreen][B]'done so remove CBT hook.[/B][/COLOR]
            Call TerminateHook
 
        End If
 
    End If
 
    [COLOR=seagreen][B]'Call next hook.[/B][/COLOR]
    HookProc = CallNextHookEx _
    (lhHook, idHook, ByVal wParam, ByVal lParam)
 
End Function
 
Private Function CallBackProc _
(ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
 
    Dim textSize As POINTAPI
    Dim tRect As RECT
    Dim lDC As Long
    Dim lStaticHwnd As Long
 
    On Error Resume Next
 
    [COLOR=seagreen][B]'catch this msg to format the msgbox.[/B][/COLOR]
    If Msg = WM_PAINT Or Msg = WM_ACTIVATE Then
 
       [COLOR=seagreen][B]'get the msgbox text window hwnd and store its DC.[/B][/COLOR]
        lStaticHwnd = FindWindowEx _
        (hwnd, 0, "STATIC", vbNullString)
 
        lDC = GetDC(hwnd)
 
       [COLOR=seagreen][B]'set the background of the msgbox text to transparent.[/B][/COLOR]
        SetBkMode lDC, 1
 
        [B][COLOR=seagreen]'set the text-alignment[/COLOR][/B]
        SetTextAlign lDC, TA_BASELINE
 
        [COLOR=seagreen][B]'store the text window metrics.[/B][/COLOR]
        GetClientRect lStaticHwnd, tRect
 
        [COLOR=seagreen][B]'hide the text window.[/B][/COLOR]
        ShowWindow lStaticHwnd, 0
 
        Select Case True
 
            [B][COLOR=seagreen]'if the BoldPart = Prompt.[/COLOR][/B]
            Case UCase(sPrompt) = UCase(sBoldPart)
 
                CreateFont lDC, Bold:=True
 
                TextOut lDC, tRect.Left + 10, _
                tRect.Bottom + 10, sPrompt, Len(sPrompt)
 
                [COLOR=seagreen][B]'if the BoldPart = N LeftMost characters.[/B][/COLOR]
                Case UCase(Left(sPrompt, Len(sBoldPart))) _
                = UCase(sBoldPart)
 
                CreateFont lDC, Bold:=True
 
                TextOut lDC, tRect.Left + 10, tRect.Bottom + 10, _
                sBoldPart, Len(sBoldPart)
 
                GetTextExtentPoint32 lDC, sBoldPart, _
                Len(sBoldPart), textSize
 
                CreateFont lDC
 
                TextOut lDC, textSize.x + tRect.Left + 10, _
                tRect.Bottom + 10, _
                Right(sPrompt, Len(sPrompt) - Len(sBoldPart)), _
                Len(sPrompt) - Len(sBoldPart)
 
            [COLOR=seagreen][B]'if the BoldPart = N RightMost characters.[/B][/COLOR]
            Case UCase(Right(sPrompt, Len(sBoldPart))) = _
            UCase(sBoldPart)
 
                CreateFont lDC
 
                TextOut lDC, tRect.Left + 10, tRect.Bottom + 10, _
                Left(sPrompt, Len(sPrompt) - Len(sBoldPart)), _
                Len(Left(sPrompt, Len(sPrompt) - Len(sBoldPart)))
 
                GetTextExtentPoint32 lDC, _
                Left(sPrompt, Len(sPrompt) - Len(sBoldPart)), _
                Len(Left(sPrompt, Len(sPrompt) - _
                Len(sBoldPart))), textSize
 
                CreateFont lDC, Bold:=True
 
                TextOut lDC, textSize.x + tRect.Left + 10, _
                tRect.Bottom + 10, (sBoldPart), Len(sBoldPart)
 
 
            [COLOR=seagreen][B]'if the BoldPart is in the middle of the Prompt text.[/B][/COLOR]
            Case InStr(1, sPrompt, sBoldPart, 1) > 1
 
                If UCase(Right(sPrompt, Len(sBoldPart))) <> _
                UCase(sBoldPart) Then
 
                    CreateFont lDC
 
                    TextOut lDC, tRect.Left + 10, tRect.Bottom + 10, _
                    Left(sPrompt, _
                    InStr(1, sPrompt, sBoldPart, 1) - 1), _
                    Len(Left(sPrompt, _
                    InStr(1, sPrompt, sBoldPart, 1) - 1))
 
                    GetTextExtentPoint32 lDC, _
                    Left(sPrompt, InStr(1, sPrompt, sBoldPart, 1) - 1), _
                    Len(Left(sPrompt, _
                    InStr(1, sPrompt, sBoldPart, 1) - 1)), textSize
 
                    CreateFont lDC, Bold:=True
 
                    TextOut lDC, textSize.x + tRect.Left + 10, _
                    tRect.Bottom + 10, (sBoldPart), Len(sBoldPart)
 
                    GetTextExtentPoint32 lDC, _
                    Left(sPrompt, InStr(1, sPrompt, sBoldPart, 1) - 1) _
                    & sBoldPart, Len(Left(sPrompt, _
                    InStr(1, sPrompt, sBoldPart, 1) - 1)) _
                    + Len(sBoldPart) - 1, textSize
 
                    CreateFont lDC
 
                    TextOut lDC, textSize.x + tRect.Left + 10, _
                    tRect.Bottom + 10, Right(sPrompt, Len(sPrompt) _
                    - InStr(1, sPrompt, sBoldPart, 1) _
                    - Len(sBoldPart) + 1), _
                    Len(Right(sPrompt, Len(sPrompt) - _
                    InStr(1, sPrompt, sBoldPart, 1) - _
                    Len(sBoldPart) + 1))
 
                End If
 
            [COLOR=seagreen][B]'if no bold text.[/B][/COLOR]
            Case InStr(1, sPrompt, sBoldPart, 1) = 0
 
               [B][COLOR=seagreen]'display default msgbox text.[/COLOR][/B]
                ShowWindow lStaticHwnd, 1
 
        End Select
 
       [COLOR=seagreen][B]'cleanup[/B][/COLOR]
        ReleaseDC hwnd, lDC
    End If
 
    [COLOR=seagreen][B]'process other msgs.[/B][/COLOR]
    CallBackProc = CallWindowProc _
    (lPrevWnd, hwnd, Msg, wParam, ByVal lParam)
 
End Function
 
Private Sub CreateFont(DC As Long, Optional Bold As Boolean)
 
    Dim uFont As LOGFONT
    Dim lNewFont As Long
 
    With uFont
        .lfFaceName = "Tahoma" & Chr$(0)
        .lfHeight = 13
        .lfWidth = 5
        .lfWeight = IIf(Bold, 900, 100)
    End With
 
    lNewFont = CreateFontIndirect(uFont)
    DeleteObject (SelectObject(DC, lNewFont))
 
End Sub
 
Private Function FormatMsgBox _
(Prompt As String, Optional BoldPart As String, _
Optional Title As String) As VbMsgBoxResult
 
   [COLOR=seagreen][B]'strore parameters in module level vars.[/B][/COLOR]
    sBoldPart = BoldPart
    sPrompt = Prompt
 
   [COLOR=seagreen][B]'setup a CBT hook.[/B][/COLOR]
    Call StartHook
 
    [COLOR=seagreen][B]'display our custom msgbox.[/B][/COLOR]
    MsgBox Prompt:=Prompt, Title:=Title
 
End Function

Limitations :

1- If there is more than 1 instance of the text to be formatted only the first (ie: the left-most) is made bold.

2- Doesn't work for multiline text.

3- Doesn't work with some msgbox icons such as vbInformation etc...

Hope the above limitations can be workedaround to make the function more flexible. Any suugestions,comments are most welcome.

Tested on Excel 2003 XP SP3.

Regards.
 
Upvote 0
VoG said:
You could also try this http://www.h3.dion.ne.jp/~sakatsu/ktMsgBox_Series_English.htm
Click to expand...

Thanks peter.

Downloaded a trial workbook and works great !

However,the ktMsgBox in the link doesn't seem to format a portion of text on a single line rather it formats each line separately which is not really what was required on this thread.

As you know, the code behind the addin is protected so i am not able to see how it works :(

But at least it's good to know that a formatted multiline msgbox can be done. Now,to know how to do it remains to be seen .

Regards.
 
Upvote 0
yytsunamiyy said:
Looking at the description and the pictures it suspiciously looks like a userform rather than a direct hook on the inbuilt msgbox. Neithertheless I stand corrected - it is possible to directly format the font in a msgbox as Jafar has shown. It just is fairly complicated.
Click to expand...


Looking at the description and the pictures it suspiciously looks like a userform rather than a direct hook on the inbuilt msgbox

Good catch yytsunamiyy !

indeed, i ran Winspector to get the class name of the ktMsgBox and it gave me"ThunderDFrame" which is the class name of excel userforms. If it was a standard built-in MsgBox it should have given me "#32770" as per the code i posted. - Well they never said it was a made out of a standard MsgBox either.

Regards.
 
Upvote 0
THANK YOU!

Thanks to everyone trying to help me out with this, but I have to say that that is C R A Z Y that you have to go through all of that just to make some text bold in a msgbox.

You did a LOT of work Jaafar!!!

I have not had a chance to go through this yet, but I will. I will let you know how things work out.

Thanks again,
Mike
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
VBA Msgbox with clickable URL
Replies
1
Views
60
dreid1011
dreid1011
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
192
ipbr21054
I
J
  • Solved
Create Word document and center title
Replies
5
Views
462
Tetra201
Tetra201
P
  • Question Question
If and ElseIf confusion !
Replies
5
Views
218
Micron
M
R
  • Solved
Control text formatting (e.g. font, color, etc.) when using Excel VBA to automate emails via Outlook
Replies
2
Views
261
Roland Hoelscher
R

Forum statistics

Threads
1,223,148
Messages
6,170,373
Members
452,324
Latest member
robertbs021

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top