Greek characters not showing properly

Formula11

Active Member
Joined
Mar 1, 2005
Messages
461
Office Version
  1. 365
Platform
  1. Windows
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.

1666763738957.png


VBA Code:
Sub test()
    MsgBox ChrW(&H3C0)
End Sub
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
You could try the code offered in post# 8 here:

 
Upvote 0
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.

VBA Code:
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




1666774822852.png
 
Upvote 0
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).
 
Upvote 0
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.

VBA Code:
#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
 
Last edited:
Upvote 0
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:
VBA Code:
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:
VBA Code:
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
 
Upvote 0
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.
 
Upvote 0
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)

VBA Code:
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
VBA 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
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,971
Members
452,371
Latest member
Frana

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