Greek characters not showing properly

[Formula11]

It looks like Greek characters (among others) are handled differently in VBA.

Trying to show "π" but getting "p" instead.

Is there a conversion method available.

Sub test()
    MsgBox ChrW(&H3C0)
End Sub

 

[FormR]

You could try the code offered in post# 8 here:

VBA display foreign character code

Hello, I'm trying to use foreign language (Hebrew) characters in VBA Msgbox. I know that if I want to use foreign language characters I need to configure in Windows, the "non unicode programs" (in the control panel>Region>Administrative), but I want to achieve this without configure this...

www.mrexcel.com

 

[Formula11]

Thanks, that was helpful and is getting a bit closer.
The code example was for a message box, and it did work.

But I can't make it into a String. So in example below, assign "π" to my_char.
This time the result is a large number.

It looks like the API is for message boxes.

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long
#Else
    Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
#End If

Public Function replace_char(Prompt As String) As String
    Prompt = Prompt & vbNullChar 'Add null terminators
    replace_char = StrPtr(Prompt)
End Function

Sub test()
    Dim my_char As String
    my_char = replace_char(ChrW(&H3C0))
    MsgBox my_char
End Sub

 

[FormR]

So in example below, assign "π" to my_char.

Hi, I really have no idea what you are trying to do in that example! Perhaps you would be better explaining in words?

 

[Formula11]

OK I understand.
I'm trying to prepare a userform with some common Greek characters that I can copy and paste onto my worksheet.
There's one command button per character.
When a command button is clicked, it would copy that character, or put it in the clipboard.
But the issue is that Greek characters seemed to be turned into something else, "π" becomes "p", others become "?".
Was hoping a function would handle this.
The example link did work, I could show "π" in a message box (the message box is like a test to show it works).

 

[FormR]

Hi, it's the native message box itself that can't display the unicode characters.

Try running the test() sub (with the other code included in the module) and you will see that the π is retained.

#If VBA7 Then
    Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long
#Else
    Private Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
#End If

Public Function MsgBoxW(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Microsoft Excel") As VbMsgBoxResult
    Prompt = Prompt & vbNullChar 'Add null terminators
    Title = Title & vbNullChar
    MsgBoxW = MessageBoxW(Application.hWnd, StrPtr(Prompt), StrPtr(Title), Buttons)
End Function

Sub test()
Dim my_char As String
my_char = ChrW(&H3C0)
MsgBoxW my_char
End Sub

 

[Formula11]

OK thanks for advising. Yes you are right about the character being retained.

The original query is part of a larger picture, and it goes like this.
- A form has command buttons with Greek characters. When clicked, it's supposed to place that character in the clipboard for Ctrl-V paste in another application.
- With the clipboard, apparently there are issues with Windows 10, in that if Explorer is opened before Excel (or vice versa) the clipboard doesn't work as intended. Instead of pasting the intended character, you get two characters such as "??".
- There were solutions online to account for this using Windows API. See code below, it may have been from here. Link
- The API code did actually work, but not entirely. Instead of pasting "π", it was "p" being pasted. This is the last bit that needs to be resolved.

Code below is altogether.
MsgBox Character gives "p". This a test.
Range("A1").Value = Character gives "π". This a test.
MyClipBoard(Character) gives "p".

The solution would be for MyClipBoard(Character) to give "π".

This is the form:

Option Explicit

Private Sub UserForm_Initialize()
    With UserForm_char
        .ButtonGreek_pi.Caption = ChrW(&H3C0): .ButtonGreek_pi.Font.Size = 12
    End With
End Sub

Private Sub ButtonGreek_pi_Click()
    Dim Character As String
    Character = Me.ButtonGreek_pi.Caption
    MsgBox Character 'Test
    Range("A1").Value = Character 'Test
    Call MyClipBoard(Character)
End Sub

In module:

Option Explicit

#If VBA7 Then
    Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
    Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
#Else
    Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
    Declare Function EmptyClipboard Lib "user32" () As Long
    Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
    Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#End If

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096


Sub form_char()
    UserForm_char.Show vbModeless
End Sub


Function MyClipBoard(MyString As String)
   #If VBA7 Then
      Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr, hClipMemory As LongPtr
   #Else
      Dim hGlobalMemory As Long, lpGlobalMemory As Long, hClipMemory As Long
   #End If
   Dim x As Long
   ' Allocate moveable global memory.
   '-------------------------------------------
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
   ' Lock the block to get a far pointer to this memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)
   ' Copy the string to this global memory.
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
   ' Unlock the memory.
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted. Please contact 14Fathoms."
      GoTo OutOfHere2
   End If
   ' Open the Clipboard to copy data to.
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted. Please contact 14Fathoms."
      Exit Function
   End If
   ' Clear the Clipboard.
   x = EmptyClipboard()
   ' Copy the data to the Clipboard.
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:
   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard. Please contact 14Fathoms."
   End If

End Function

 

[FormR]

Hi, that's a long way from the OP and too involved for me at moment I'm afraid - perhaps someone else will jump in.

 

[Formula11]

OK no worries thanks for your help.

 

[Jimmypop]

OK no worries thanks for your help.

Try the below... one step closer I think...

MsgBox Character gives "π". This a test.
Range("A1").Value = Character gives "π". This a test.
MyClipBoard(Character) still gives "p". (Still trying to find solution)

Module Code
Option Explicit
#If VBA7 Then
    Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hWnd As LongPtr, ByVal lpText As LongPtr, ByVal lpCaption As LongPtr, ByVal uType As Long) As Long
    Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As LongPtr
    Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
    Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
#Else
    Declare Function MessageBoxW Lib "user32" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal uType As Long) As Long
    Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Declare Function CloseClipboard Lib "user32" () As Long
    Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
    Declare Function EmptyClipboard Lib "user32" () As Long
    Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
    Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#End If
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function MyClipBoard(MyString As String)
    #If VBA7 Then
        Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr, hClipMemory As LongPtr
    #Else
        Dim hGlobalMemory As Long, lpGlobalMemory As Long, hClipMemory As Long
    #End If
    Dim x           As Long
    ' Allocate moveable global memory.
    '-------------------------------------------
    hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
    ' Lock the block to get a far pointer to this memory.
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    ' Copy the string to this global memory.
    lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
    ' Unlock the memory.
    If GlobalUnlock(hGlobalMemory) <> 0 Then
        MsgBox "Could Not unlock memory location. Copy aborted. Please contact 14Fathoms."
        GoTo OutOfHere2
    End If
    ' Open the Clipboard to copy data to.
    If OpenClipboard(0&) = 0 Then
        MsgBox "Could Not open the Clipboard. Copy aborted. Please contact 14Fathoms."
        Exit Function
    End If
    ' Clear the Clipboard.
    x = EmptyClipboard()
    ' Copy the data to the Clipboard.
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
    If CloseClipboard() = 0 Then
        MsgBox "Could Not close Clipboard. Please contact 14Fathoms."
    End If
End Function
Public Function MsgBoxW(Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String = "Microsoft Excel") As VbMsgBoxResult
    Prompt = Prompt & vbNullChar        'Add null terminators
    Title = Title & vbNullChar
    MsgBoxW = MessageBoxW(Application.hWnd, StrPtr(Prompt), StrPtr(Title), Buttons)
End Function
Sub form_char()
    UserForm_char.Show vbModeless
End Sub

Userform Code

Private Sub UserForm_Initialize()
    With UserForm_char
        .ButtonGreek_pi.Caption = ChrW(&H3C0): .ButtonGreek_pi.Font.Size = 12
    End With
End Sub
Private Sub ButtonGreek_pi_Click()
    Dim Character   As String
    Dim my_char     As String
    Character = Me.ButtonGreek_pi.Caption
    my_char = ChrW(&H3C0)
    MsgBoxW my_char
    Range("A1").Value = Character        'Test
    Call MyClipBoard(Character)
End Sub