Попытка отобразить плохо декодированные символы Юникода в ячейках Excel на языке оригинала. - PullRequest
0 голосов
/ 31 октября 2019

Для ячеек с 'gibberish' в файле Excel мне нужно представить их (например, в другой ячейке или, по крайней мере, на данный момент, в окне сообщения) на языке, с которого они исходят.

Я не смог найти ответ, относящийся к этой проблеме, и решение специально для VBA для Excel. Может ли кто-нибудь помочь?

Я нашел подсказку для решения по адресу https://www.di -mgt.com.au / howto-convert-vba-unicode-to-utf8.html , ноЯ не могу вытащить рабочий код на моей стороне.

Если бы кто-нибудь захотел пройтись по функциям, упомянутым в приведенной выше ссылке, я просто сделал:

  1. объединить 'блок переменных в одну (там их две),
  2. вставляет все функции ниже объявленных переменных (так как одна преобразует недекодированные строки Юникода в байты, а другая - в правильно закодированные строки Юникода),
  3. и, предполагая, что я хочу отобразить ячейку A1, я немного изменил последнюю часть кода, которая должна сделать трюк, чтобы:

Public Sub Test_Utf8String()
    Dim abData() As Byte
    Dim b() As Byte
    Dim a As String
    Dim s As String
    Dim i As Integer

    With ActiveSheet
        abData = StrConv(.Cells(1, 1).Value, vbFromUnicode)
        a = ""

        For i = 0 To UBound(abData)
            If i = UBound(abData) Then
                a = a & Hex(abData(i))
            Else:
                a = a & Hex(abData(i)) & " "
            End If
        Next

        b = Utf8BytesFromString(a)
        s = Utf8BytesToString(b)
        MsgBox (s)
    End With
End Sub

И он выдает ошибки, которые яне может справиться.

Есть идеи или другие способы решения этой проблемы?

1 Ответ

0 голосов
/ 02 ноября 2019

Указанный код работает ... просто:

  1. Создать модуль1

  2. Скопируйте этот код:

Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cbMultiByte As Long, _
    ByVal lpDefaultChar As Long, _
    ByVal lpUsedDefaultChar As Long) As Long

Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    ByVal lpMultiByteStr As Long, _
    ByVal cchMultiByte As Long, _
    ByVal lpWideCharStr As Long, _
    ByVal cchWideChar As Long _
    ) As Long

Private Const CP_UTF8 = 65001

Public Function Utf8BytesFromString(strInput As String) As Byte()
    Dim nBytes As Long
    Dim abBuffer() As Byte
    ' Catch empty or null input string
    Utf8BytesFromString = vbNullString
    If Len(strInput) < 1 Then Exit Function
    ' Get length in bytes *including* terminating null
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, 0&, 0&, 0&, 0&)
    ' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
    ReDim abBuffer(nBytes - 2)  ' NB ReDim with one less byte than you need
    nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
    Utf8BytesFromString = abBuffer
End Function




''' Return length of byte array or zero if uninitialized
Private Function BytesLength(abBytes() As Byte) As Long
    ' Trap error if array is uninitialized
    On Error Resume Next
    BytesLength = UBound(abBytes) - LBound(abBytes) + 1
End Function

''' Return VBA "Unicode" string from byte array encoded in UTF-8
Public Function Utf8BytesToString(abUtf8Array() As Byte) As String
    Dim nBytes As Long
    Dim nChars As Long
    Dim strOut As String
    Utf8BytesToString = ""
    ' Catch uninitialized input array
    nBytes = BytesLength(abUtf8Array)
    If nBytes <= 0 Then Exit Function
    ' Get number of characters in output string
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, 0&, 0&)
    ' Dimension output buffer to receive string
    strOut = String(nChars, 0)
    nChars = MultiByteToWideChar(CP_UTF8, 0&, VarPtr(abUtf8Array(0)), nBytes, StrPtr(strOut), nChars)
    Utf8BytesToString = Left$(strOut, nChars)
End Function
  1. Создать модуль 2.
  2. Скопировать этот код:
 Sub Test_Utf8String()
        Dim abData() As Byte
        Dim b() As Byte
        Dim a As String
        Dim s As String
        Dim i As Integer

        With ActiveSheet
            abData = StrConv(.Cells(1, 1).Value, vbFromUnicode)
            a = ""

            For i = 0 To UBound(abData)
                If i = UBound(abData) Then
                    a = a & Hex(abData(i))
                Else:
                    a = a & Hex(abData(i)) & " "
                End If
            Next

            b = Utf8BytesFromString(a)
            s = Utf8BytesToString(b)
            MsgBox (s)
        End With
    End Sub

После этого скопируйте предложенный тестовый образец "ОбщинÑка болница Др. Стамен Григоров" в ячейку A1.

Вы получите this result в соответствии сваш план и ваша реферальная ссылка

Надеюсь, это поможет!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...