Non-English characters in MsgBox prompt

[eirikdaude]

I am having a bit of an issue with some characters not displaying for my messageboxes.

In this very simple test macro, you can see that the three letters from the Scandinavian alphabet are not being displayed in the dialog boxes it generates.

Sub test()
    Dim v As Variant
    MsgBox Prompt:="This is a test: æøå ÆØÅ", Title:="Test"
    v = InputBox(Prompt:="This is also a test: æøå ÆØÅ", Title:="Test")
End Sub

This has not been an issue before I recently moved to a new laptop. Is this a recent change in Excel which is causing the problem, or is it some setting I need to en- / disable on my new computer? Is there some way I can ensure that these characters are displayed properly for my users as well?

Cross-posted on superuser.com

 

[Jaafar Tribak]

It is easier to do this for the MsgBox as it is a wrapper for the MessageBoxW api . More difficult for the Inputbox.

Workbook Demo

The following code defines the two unicode InputBoxU and MsgBoxU custom functions:

1- Standard Module:

Option Explicit

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type InputData
    PROMPT As String * 255
    TITLE As String * 255
    DEFAULT As String * 255
    X As Long
    Y As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
    Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamW" (ByVal hInstance As LongPtr, ByVal lpTemplate As LongPtr, ByVal hWndParent As LongPtr, ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As LongPtr
    Private Declare PtrSafe Function EndDialog Lib "user32" (ByVal hDlg As LongPtr, ByVal nResult As LongPtr) As Long
    Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextW" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As Any) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr
    Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare PtrSafe Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As LongPtr, Optional ByVal pszStrPtr As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
    Private Declare PtrSafe Function MsgBoxAlias Lib "user32" Alias "MessageBoxW" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, Optional ByVal lpCaption As LongPtr, Optional ByVal wType As Long = 0) As Long
#Else
    Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
    Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamW" (ByVal hInstance As Long, ByVal lpTemplate As Long, ByVal hWndParent As Long, ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Long
    Private Declare Function EndDialog Lib "user32" (ByVal hDlg As Long, ByVal nResult As Long) As Long
    Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextW" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As Any) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Function SysReAllocString Lib "oleAut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
    Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Private Declare Function MsgBoxAlias Lib "user32" Alias "MessageBoxW" (ByVal hwnd As Long, ByVal lpText As Long, Optional ByVal lpCaption As Long, Optional ByVal wType As Long = 0) As Long
#End If



Function InputBoxU _
    (ByVal PROMPT As String, _
    Optional ByVal TITLE As String = "Microsoft Excel", _
    Optional ByVal DEFAULT As String = vbNullString, _
    Optional ByVal XPos As Variant, _
    Optional ByVal YPos As Variant _
) As String

    Const SM_CXSCREEN = 0
    Const SM_CYSCREEN = 1
   
    #If VBA7 Then
        Dim hMod As LongPtr, lDlgRet As LongPtr
        hMod = GetModuleHandle("VBE7INTL.dll")
    #Else
        Dim hMod As Long, lDlgRet As Long
        hMod = GetModuleHandle("VBE6INTL.dll")
    #End If

    Dim uInpData As InputData

    With uInpData
        If IsMissing(XPos) Then
            .X = GetSystemMetrics(SM_CXSCREEN) / 2
        Else
            .X = XPos
        End If
        If IsMissing(YPos) Then
            .Y = GetSystemMetrics(SM_CYSCREEN) / 2
        Else
            .Y = YPos
        End If
        If Not IsMissing(XPos) And Not IsMissing(YPos) Then
            If Not IsNumeric(XPos) Or Not IsNumeric(YPos) Then
                Exit Function
            End If
        End If
        .PROMPT = PROMPT & vbNullChar
        .TITLE = TITLE & vbNullChar
        .DEFAULT = DEFAULT & vbNullChar
    End With


    lDlgRet = DialogBoxParam(hInstance:=hMod, _
                           lpTemplate:=4031, _
                           hWndParent:=Application.hWnd, _
                           lpDialogFunc:=AddressOf DlgProc, _
                            dwInitParam:=VarPtr(uInpData))
                           
    InputBoxU = GetStrFromPtrW(lDlgRet)

End Function

#If Win64 Then
    Private Function DlgProc( _
        ByVal hWnd As LongLong, _
        ByVal wMsg As Long, _
        ByVal wParam As LongLong, _
        ByVal lParam As LongLong _
    ) As LongLong
#Else
    Private Function DlgProc( _
        ByVal hWnd As Long, _
        ByVal wMsg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long _
    ) As Long
#End If

    Const WM_INITDIALOG = &H110
    Const WM_COMMAND = &H111
    Const WM_CLOSE = &H10
    Const IDOK = 1
    Const IDCANCEL = 2
    Const WM_GETTEXT = &HD&
    Const WM_SETTEXT = &HC
    Const MAX_PATH = 255
    Const SM_CXSCREEN = 0
    Const SM_CYSCREEN = 1
    Const SWP_NOSIZE = &H1
    Const SWP_SHOWWINDOW = &H40

    Dim uInpData As InputData, tRect As RECT
    Dim sPrompt As String, sTitle As String, sDefault As String
    Dim XPos As Long, YPos As Long
    Dim sBuff  As String, lRet  As Long
   
    Select Case wMsg
        Case WM_INITDIALOG
            Call CopyMemory(ByVal uInpData, ByVal lParam, LenB(uInpData))
            With uInpData
                sPrompt = Left(.PROMPT, InStr(1, .PROMPT, vbNullChar) - 1)
                sTitle = Left(.TITLE, InStr(1, .TITLE, vbNullChar) - 1)
                sDefault = Left(.DEFAULT, InStr(1, .DEFAULT, vbNullChar) - 1)
                XPos = .X
                YPos = .Y
            End With
            Call GetWindowRect(hWnd, tRect)
            With tRect
                If XPos = GetSystemMetrics(SM_CXSCREEN) / 2 Then
                    XPos = XPos - (.Right - .Left) / 2
                End If
                If YPos = GetSystemMetrics(SM_CYSCREEN) / 2 Then
                    YPos = YPos - (.Bottom - .Top) / 2
                End If
                Call SetWindowPos(hWnd, 0, XPos, YPos, 0, 0, SWP_NOSIZE Or SWP_SHOWWINDOW)
            End With
            Call SetDlgItemText(hWnd, 4900, ByVal StrPtr(sDefault))
            Call SetDlgItemText(hWnd, 4901, ByVal StrPtr(sPrompt))
            Call DestroyWindow(GetDlgItem(hWnd, 4902))
            Call SendMessage(hWnd, WM_SETTEXT, False, ByVal StrPtr(sTitle))
        Case WM_COMMAND
            Select Case LOWORD(CLng(wParam))
                Case IDOK
                    sBuff = Space(MAX_PATH)
                    lRet = CLng(SendMessage(GetDlgItem(hWnd, 4900), WM_GETTEXT, MAX_PATH, ByVal StrPtr(sBuff)))
                    EndDialog hWnd, StrPtr(Left(sBuff, lRet))
                    DlgProc = 1
                    Exit Function
                Case IDCANCEL
                    EndDialog hWnd, StrPtr(vbNullString)
                    sDefault = vbNullString
                    DlgProc = 1
                    Exit Function
            End Select
            Exit Function
        Case WM_CLOSE
            EndDialog hWnd, 0
            sDefault = vbNullString
            DlgProc = 1
            Exit Function
    End Select
    DlgProc = 0
   
End Function

Function MsgBoxU( _
    ByVal PROMPT As String, _
    Optional ByVal BUTTONS As VbMsgBoxStyle, _
    Optional ByVal TITLE As String = vbNullChar _
) As VbMsgBoxResult
   
        MsgBoxU = MsgBoxAlias(Application.hWnd, StrPtr(PROMPT), StrPtr(TITLE), BUTTONS)
End Function


#If Win64 Then
    Private Function GetStrFromPtrW(ByVal Ptr As LongLong) As String
#Else
    Private Function GetStrFromPtrW(ByVal Ptr As Long) As String
#End If
    Call SysReAllocString(VarPtr(GetStrFromPtrW), Ptr)
End Function

Private Function LOWORD(dw As Long) As Integer
    If dw And &H8000& Then
        LOWORD = dw Or &HFFFF0000
    Else
        LOWORD = dw And &HFFFF&
    End If
End Function

2- Code Usage Test:

Sub Test()

    Dim sRet As String
   
    sRet = InputBoxU(PROMPT:="This is also a test: æøå ÆØÅ", TITLE:="Test", DEFAULT:="This is also a test: æøå ÆØÅ")
   
    If StrPtr(sRet) Then
        MsgBoxU sRet, vbInformation, "TEST"
    End If
 
 End Sub

 

[Jaafar Tribak]

Just to avoid confusion:

The reason the above dialogs display the wrong characters is because the Norwegian font is not installed in my vbe.

But the code works. This is what the dialogs look like for Norwegian when the text is taken from a worksheet cell:

 

[eirikdaude]

Just to avoid confusion:

The reason the above dialogs display the wrong characters is because the Norwegian font is not installed in my vbe.

But the code works. This is what the dialogs look like for Norwegian when the text is taken from a worksheet cell:

View attachment 51928


View attachment 51929

Thanks - I guess the fonts must have been included on my previous computers (the post here suggests it may have to do with the regional settings).

While your code works, I am going to go with the solution I later found of using the ChrW function to pass the unicode for the characters into the string. I'll keep the solution in your post in mind for when I need to use messageboxes in larger projects.