Issue
The ChrW
charcode argument is a Long
that identifies a character, but doesn't allow values greater than 65535 (hex value &HFFFF
) -
see MS Help.
For instance Miscellaneous symbols and pictographs can be found at Unicode hex block 1F300-1F5FF
. So I didn't find any way to represent the proposed hex values of ►1F512
and 1F513
for a opened or closed padlock symbol
precisely in this charcode block, as of Course ChrW(&H1F512)
would result in an invalid procedure/argument call.
A recent answer found an possibly erratic alternative referring to a lower charcode
(via ChrW(&HE1F7)
and ChrW(&HE1F6)
), but I'm searching for a way to get the higher charcode representation.
Question
Is there a systematic way to express Unicode characters found in hexadecimal code blocks greater than FFFF
by means of VBA or a work around?
as an alternative to T.M.
Don't forget to add a reference to 'Microsoft HTML Object Library'
Function GetUnicode(CharCodeString As String) As String
Dim Doc As New HTMLDocument
Doc.body.innerHTML = "&#x" & CharCodeString & ";"
GetUnicode = Doc.body.innerText
End Function
The function that works for Unicode characters outside the basic multilingual plane (BMP) is WorksheetFunction.Unichar()
. This example converts cells containing hexadecimal into their Unicode equivalent:
Sub Convert()
For i = 1 To Selection.Cells.Count
n = WorksheetFunction.Hex2Dec(Selection.Cells(i).Text)
Selection.Cells(i) = WorksheetFunction.Unichar(n)
Next
End Sub
Original selection before running macro:
After running macro:
If your Excel is older and WorksheetFunction
is not available, building UTF-16 surrogates manually works, too:
Sub Convert()
For i = 1 To Selection.Cells.Count
n = CLng("&H" + Selection.Cells(i).Text) 'Convert hexadecimal text to integer
If n < &H10000 Then 'BMP characters
Selection.Cells(i) = ChrW(n)
Else
'UTF-16 hi/lo surrogate conversion
'Algorithm:
'1. Code point - 10000h (max U+10FFFF give 9FFFF...20 bits)
'2. In binary, but 10 bits in first surrogate (x) and 10 in 2nd surrogate (y)
' 110110xxxxxxxxxx 110111yyyyyyyyyy
tmp = n - &H10000
h = &HD800 + Int(tmp / (2 ^ 10)) 'bitwise right shift by 10
l = &HDC00 + (tmp And &H3FF) 'bitwise AND of last 10 bits
Selection.Cells(i) = ChrW(h) + ChrW(l)
End If
Next
End Sub
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With