Option Explicit



'######################################################

'----------------------------------

Sub test_message()



    Dim a



    a = myMsg("This first line is a lot bigger than", "this the second", _

        "But not nearly as big as this line which I'll call the thrid line", _

        "line 4 is small")

End Sub

'----------------------------------

Function myMsg(ParamArray PromptTxt())

'

' Centre prompt on Excel message box

'

' Written by Andy Pope @ Digitab    19-March-1998

'

'

    Dim tmpText As TextBox          ' temporary object used to get true Font sizing

    Dim RealTextWidth As Single     ' size of widest string

    Dim ChopTrailers As Integer     ' start of trailing spaces

    Dim PromptBuf As String         ' new msgbox prompt

    Dim i As Integer



'-

' Create a textbox of worksheet in order to get true length of text

'-

    Set tmpText = Worksheets(1).TextBoxes.Add(1, 1, 1, 1)

'-

' set properties of textbox to mimic normal messagebox appearence

'-

    With tmpText

        .Font.Name = "MS Sans Serif"

        .Font.Size = 8.5

        .VerticalAlignment = xlTop

        .HorizontalAlignment = xlLeft

        .Orientation = xlHorizontal

        .AutoSize = True

    End With

'-

' determine the actual longest string

'-

    For i = LBound(PromptTxt) To UBound(PromptTxt)

        tmpText.Text = CStr(PromptTxt(i))

        If tmpText.Width > RealTextWidth Then RealTextWidth = tmpText.Width

    Next i

'-

' pad out lines

' the period is used to fool the textbox to take trailing spaces

' Chop keeps a record of where the trailing space start

'-

    For i = LBound(PromptTxt) To UBound(PromptTxt)

        ChopTrailers = Len(PromptTxt(i))

        tmpText.Text = CStr(PromptTxt(i)) & "."

        Do While tmpText.Width < RealTextWidth

            tmpText.Text = " " & Left(tmpText.Text, Len(tmpText.Text) - 1) & " ."

            ChopTrailers = ChopTrailers + 1

        Loop

'-

' Build new prompt and append linefeeds

'-

        PromptBuf = PromptBuf & Left(tmpText.Text, ChopTrailers) & Chr(10)

    Next i

'-

' remove trailing line feed from prompt

'-

    PromptBuf = Left(PromptBuf, Len(PromptBuf) - 1)

    MsgBox PromptBuf

    

'-

' remove textbox from worksheet

'-

    tmpText.Delete

    

End Function


'-----------------------------------

'################################################