Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Get Unicode characters with charcode values greater hex `FFFF`

Tags:

excel

unicode

vba

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?

like image 489
T.M. Avatar asked May 06 '19 15:05

T.M.


2 Answers

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
like image 179
milevyo Avatar answered Sep 21 '22 11:09

milevyo


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:

Two cells selected with text 1f512 and 1f513

After running macro:

Images of Unicode LOCK and OPEN LOCK symbols

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
like image 21
Mark Tolonen Avatar answered Sep 20 '22 11:09

Mark Tolonen