将带有 unicode 的文本转换为 HTML 实体答案

【问题标题】：Convert text with unicode to HTML entities将带有 unicode 的文本转换为 HTML 实体
【发布时间】：2019-08-20 20:26:34
【问题描述】：

在VBA中，如何将包含Unicode的文本转换为HTML实体？

例如。测试字符：èéâ????将转换为Test chars: &#xE8;&#xE9;&#xE2;&#x1F44D;

【问题讨论】：

标签： vba unicode html-entities

【解决方案1】：

在 Excel 中，字符使用 Unicode UTF-16 存储。 “竖起大拇指”字符 (?) 对应于 Unicode 字符 U+1F44D, encoded as follows：

在 UTF-16（十六进制）中：0xD83D 0xDC4D (d83ddc4d)

UTF-16（十进制）：55357、56397

以下函数（和测试过程）应按预期转换：

Sub test()
    txt = String2Html("Test chars: èéâ" & ChrW(&HD83D) & ChrW(&HDC4D))
    debug.print txt ' -> Test chars: &#xE8;&#xE9;&#xE2;&#x1F44D;
End Sub



Function String2Html(strText As String) As String

Dim i As Integer
Dim strOut As String
Dim char As String
Dim char2 As String
Dim intCharCode As Integer
Dim intChar2Code As Integer
Dim unicode_cp As Long


For i = 1 To Len(strText)
    char = Mid(strText, i, 1)
    intCharCode = AscW(char)
    If (intCharCode And &HD800) = &HD800 Then
        i = i + 1
        char2 = Mid(strText, i, 1)
        intChar2Code = AscW(char2)
        unicode_cp = (intCharCode And &H3FF) * (2 ^ 10) + (intChar2Code And &H3FF)
        strOut = strOut & "&#x" & CStr((intCharCode And &H3C0) + 1) & Hex(unicode_cp) & ";"
    ElseIf intCharCode > 127 Then
        strOut = strOut & "&#x" & Hex(intCharCode) & ";"
    ElseIf intCharCode < 0 Then
        strOut = strOut & "&#x" & Hex(65536 + intCharCode) & ";"
    Else
        strOut = strOut & char
    End If
Next

String2Html = strOut

End Function

【讨论】：

我改进了处理字符 >= U+8000 的代码，包括不超过 U+10FFFF 的字符

【解决方案2】：

将 Unicode 转换为 Asci（例如：æ 至 &#230;）

 Public Function UnicodeToAscii(sText As String) As String
  Dim x As Long, sAscii As String, ascval As Long

  If Len(sText) = 0 Then
    Exit Function
  End If

  sAscii = ""
  For x = 1 To Len(sText)
    ascval = AscW(Mid(sText, x, 1))
    If (ascval < 0) Then
      ascval = 65536 + ascval ' http://support.microsoft.com/kb/272138
    End If
    sAscii = sAscii & "&#" & ascval & ";"
  Next
  UnicodeToAscii = sAscii
End Function

将 Asci 转换成 Unicode（例如：&#230; ）

Public Function AsciiToUnicode(sText As String) As String
  Dim saText() As String, sChar As String
  Dim sFinal As String, saFinal() As String
  Dim x As Long, lPos As Long

  If Len(sText) = 0 Then
    Exit Function
  End If

  saText = Split(sText, ";") 'Unicode Chars are semicolon separated

  If UBound(saText) = 0 And InStr(1, sText, "&#") = 0 Then
    AsciiToUnicode = sText
    Exit Function
  End If

  ReDim saFinal(UBound(saText))

  For x = 0 To UBound(saText)
    lPos = InStr(1, saText(x), "&#", vbTextCompare)

    If lPos > 0 Then
      sChar = Mid$(saText(x), lPos + 2, Len(saText(x)) - (lPos + 1))

      If IsNumeric(sChar) Then
        If CLng(sChar) > 255 Then
          sChar = ChrW$(sChar)
        Else
          sChar = Chr$(sChar)
        End If
      End If

      saFinal(x) = Left$(saText(x), lPos - 1) & sChar
    ElseIf x < UBound(saText) Then
      saFinal(x) = saText(x) & ";" 'This Semicolon wasn't a Unicode Character
    Else
      saFinal(x) = saText(x)
    End If
  Next

  sFinal = Join(saFinal, "")
  AsciiToUnicode = sFinal

  Erase saText
  Erase saFinal
End Function

我希望这会对某人有所帮助，我从here得到这个代码

【讨论】：