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

 

[Jimmypop]

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

UPDATE: Try this as well... not sure if it is exactly what you are looking for...

MsgBox Character gives "π". This a test.
Range("A1").Value = Character gives "π". This a test.
CopyTextToClipboard gives "π".

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
#Else
    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
Sub form_char()
    UserForm_char.Show vbModeless
End Sub
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 CopyTextToClipboard()
'PURPOSE: Copy a given text to the clipboard (using DataObject)
'SOURCE: www.TheSpreadsheetGuru.com
'NOTES: Must enable Forms Library: Checkmark Tools > References > Microsoft Forms 2.0 Object Library
Dim obj As New DataObject
Dim txt As String
Dim Character   As String
Character = ChrW(&H3C0)
'Put some text inside a string variable
  txt = Character
'Make object's text equal above string variable
  obj.SetText txt
'Place DataObject's text into the Clipboard
  obj.PutInClipboard
'Notify User
  MsgBox "There is now text copied to your clipboard!", vbInformation
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 CopyTextToClipboard
End Sub

 

[Formula11]

Thanks Jimmypop, that was close but still have the issue with Windows Explorer being open.
It does work if Explorer is closed though.

 

[Jimmypop]

Ok no problem... Just trying to figure out why you are saying that if Windows Explorer is closed then it works? I did the test on a sheet and my Explorer is open and it worked. How do you start Excel if Explorer is closed and why do you need to close Explorer? Just curious...

 

[Formula11]

Yes I understand, from what I read it does seem to depend on other variables such as 64-bit/32-bit and so on, for some it's the other way around in that Explorer has to be opened first.
The part about Explorer being closed ... for your code, on my system, I have to close Explorer for it to work, if open, I get ?? instead of π.

 

[Jimmypop]

I see... not sure what the problem could be then... as I said thinking it is a step closer... maybe someone else can give more insight?

 

[FormR]

Hi, try changing your module code to this>

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

Public Const GMEM_MOVEABLE As Long = &H2
Public Const GMEM_ZEROINIT As Long = &H40
Public Const CF_UNICODETEXT As Long = &HD


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(GMEM_MOVEABLE Or GMEM_ZEROINIT, LenB(MyString) + 2)
   ' Lock the block to get a far pointer to this memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)
   ' Copy the string to this global memory.
   lpGlobalMemory = lstrcpy(lpGlobalMemory, StrPtr(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_UNICODETEXT, hGlobalMemory

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

End Function

 

[Formula11]

Great thanks FormR this now works.
After testing with and without Explorer there are no issues so far.
Well done for solving.

 

[FormR]

Good stuff - just a hint, next time start out with the full question - i.e. posting the API code from the outset and asking how it can be changed to handle Greek (unicode) characters would have probably elicited a more direct/quicker resolution.

 

[Dan_W]

I see... not sure what the problem could be then... as I said thinking it is a step closer... maybe someone else can give more insight?

Hi - as it happens, there has been an issue with DataObject / Clipboard since Win 8 apparently - I went into a bit more detail about it here: Getting "??" when pasting from a TextBox and some more discussion about it here: copy to Clipboard vba problems

It happens to me every couple of months, and the only thing that has worked for me is, as Formula11 pointed out - closing down ALL of the explorer windows. Again, it seems to be the DataObject that's the problem, and so using an API will resolve it - that's why your proposed solution likely didn't work (thought it normally would've), whereas FormR's did.