使用VBA在Office中输入特殊字符（续）

《使用VBA在Office中输入特殊字符（3/3）》 介绍了输入任意特殊符号的方法，并对于其编码原理进行了解释。感谢网友T_DC_Q在留言区提出的问题，输入WingDing2字体中的勾选符号（方框中对号）时，前面会出现一个多余的五边形，如下图中A1单元格所示。

针对这个问题，先查看一下选中符号的字符代码为0x52，也就是十进制的82。

原代码的BUG在于疏忽了RFC2781规范中的第一条，对于字符代码值小于 0x10000的编码方式为直接直接转换为16bit的无符号整数。

https://tools.ietf.org/html/rfc2781
2.1 Encoding UTF-16

Encoding of a single character from an ISO 10646 character value to
UTF-16 proceeds as follows. Let U be the character number, no greater
than 0x10FFFF.

If U < 0x10000, encode U as a 16-bit unsigned integer and
terminate.

更新自定义函数如下。

Function UTF16(sHex As String, Optional sMode As String = "HEX") As String
    Dim lByte, hByte, arrRes
    If Application.Hex2Dec(sHex) > &H10000 Then
        '&HDC00 = 56320, &HD800 = 55296
        lByte = Hex(56320 Or (&H3FF And Application.Hex2Dec(sHex)))
        hByte = Hex(55296 Or ((&HFFC00 And (Application.Hex2Dec(sHex) - &H10000)) / &H400))
        arrRes = Array(Right(hByte, 2), Left(hByte, 2), Right(lByte, 2), Left(lByte, 2))
    Else
        sHex = Right("0000" & sHex, 4)
        arrRes = Array(Right(sHex, 2), Left(sHex, 2))
    End If
    If sMode = "DEC" Then
        For i = LBound(arrRes) To UBound(arrRes)
            arrRes(i) = Application.Hex2Dec(arrRes(i))
        Next
    End If
    UTF16 = Join(arrRes)
End Function

【代码解析】
第8~11行代码处理代码值小于 0x10000的字符。
第9行代码将代码值补全为4位。
第10行代码分别提取高位和低位。
其余代码没有变化，这里不再赘述。
测试代码如下。

Sub InsertSymbol()
    Dim strChar As String, iNum
    Dim arrByte(0 To 3) As Byte
    iNum = Split(UTF16("52", "DEC"))
    For i = 0 To UBound(iNum)
        arrByte(i) = iNum(i)
    Next
    strChar = arrByte
    ActiveCell.Formula = strChar
    ActiveCell.Font.Name = "Wingdings 2"
End Sub

运行代码可以在活动单元格中输入正确的特殊字符。