《使用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-16Encoding 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
运行代码可以在活动单元格中输入正确的特殊字符。