Convert text with unicode to HTML entities

问题

In VBA, how do you convert text containing Unicode to HTML entities?

Eg. Test chars: èéâ👍 would be converted to Test chars: èéâ👍

回答1:

In Excel, characters are stored using Unicode UTF-16. The "Thumbs up" character (👍) corresponds to the Unicode character U+1F44D, encoded as follows:

in UTF-16 (hex) : 0xD83D 0xDC4D (d83ddc4d)

in UTF-16 (decimal) : 55357 , 56397

The following function (and test procedure) should convert as expected:

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

回答2:

To convert Unicode to Asci (eg: æ to æ)

 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

To convert Asci to Unicode (eg: æ to æ)

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

I hope this would be help someone, I got this code from here

来源：https://stackoverflow.com/questions/46763135/convert-text-with-unicode-to-html-entities

标签

vba

unicode

html-entities