Программа Word VBA читает символ Emoji (4 байта) как "12"

Ответ 1

Вот мои последние убеждения и выводы.

Это, вероятно, ошибка в MS Word VBA, основанная на тестах, выполненных AAA в Excel, Powerpoint и Word. У некоторых людей нет этой ошибки (см. Комментарии).

Объекты VBA дают недопустимое значение для эмодзи, но свойство XML является правильным. XML слишком сложен, чтобы его можно было легко проанализировать, поэтому в комментариях Флорент Б. нашел самый простой обходной путь, заключающийся в "воссоздании документа из себя":

ActiveDocument.Content.InsertXML ActiveDocument.Content.XML

К сожалению, в моем личном случае, это может иметь некоторые побочные эффекты, такие как идентификаторы формы перенумерованы.

Итак, я расширил приведенный выше код, чтобы исправить только символы эмодзи в исходном документе, остальное осталось без изменений, путем:

• копирование XML в новый документ,
• затем синтаксический анализ каждого символа, длина текста которого> 1, в новом документе (т.е. за пределами базовой многоязычной плоскости Unicode, содержащей эмодзи и многие другие символы),
• также анализ исходного документа (при условии, что символы должны быть в том же порядке, что и в новом документе, и их длина текста одинакова),
• копирование этих символов из нового документа обратно в исходный документ,
• закрытие нового документа.

Хорошо, макросы работают дольше, но я не смог найти лучшего решения.

Вот мой код, упрощенный (вы можете быть удивлены бесполезной коллекцией объектов Range, где каждый Range является одним символьным объектом, на самом деле я не предоставляю оригинальный код для функции Split_Into_Ranges, которая намного больше, но быстрее, но это работает и хорошо демонстрирует решение в подпункте correct_emojis):

Sub test()

    Dim text As String
    Dim length As Integer
    Dim arrBytes() As Byte

    Dim zranges As Collection
    Set zranges = Split_Into_Ranges(ActiveDocument)

    Call correct_emojis(zranges) ' <=== here the important algorithm

    text = ActiveDocument.Range.Characters(1).text
    length = Len(ActiveDocument.Range.Characters(1).text)
    arrBytes = ActiveDocument.Range.Characters(1).text

End Sub

Function Split_Into_Ranges(ioDocument As Document) As Collection

    Dim zranges As Collection
    Set zranges = New Collection
    For i = 1 To ioDocument.Characters.Count
        zranges.Add ioDocument.Characters(i)
    Next
    Set Split_Into_Ranges = zranges

End Function

Sub correct_emojis(zranges As Collection)

    Dim current_emoji_zranges As Collection
    Dim temp_zranges As Collection
    Dim temp_emoji_zranges As Collection
    Dim doc_current As Document
    Dim doc_temp As Document
    Dim arrBytes() As Byte

    Set doc_current_zranges = get_emoji_zranges(zranges)
    If doc_current_zranges.Count = 0 Then
        Exit Sub
    End If

    Set doc_current = ActiveDocument
    Set doc_temp = Documents.Add()
    Call doc_temp.Content.InsertXML(doc_current.Content.XML)
    Set temp_zranges = Split_Into_Ranges(doc_temp)

    Set current_emoji_zranges = get_emoji_zranges(zranges)
    Set temp_emoji_zranges = get_emoji_zranges(temp_zranges)

    For i = 1 To current_emoji_zranges.Count
        If 0 = 1 Then
            arrBytes = current_emoji_zranges(i).Characters(1).text
            arrBytes = temp_emoji_zranges(i).Characters(1).text
        End If
        current_emoji_zranges(i).Characters(1).text = temp_emoji_zranges(i).Characters(1).text
    Next

    Call doc_temp.Close(False)

End Sub

Function get_emoji_zranges(zranges As Collection) As Collection

    Dim emoji_zranges As Collection

    Set emoji_zranges = New Collection
    For i = 1 To zranges.Count
        If Len(zranges(i).text) > zranges(i).Characters.Count Then
            For j = 1 To zranges(i).Characters.Count
                If Len(zranges(i).Characters(j).text) > 1 Then
                    emoji_zranges.Add (zranges(i))
                End If
            Next
        End If
    Next

    Set get_emoji_zranges = emoji_zranges

End Function

Ответ 2

Надеюсь, это поможет: основываясь на комментариях @SandraRossi, приведенных выше, кажется, что вклад от панели эмодзи неправильно переведен в суррогатную кодовую точку. Если вы сохраните документ, содержащий оба символа (один из панели Emoji, а другой из меню, как вы описали) в виде документа XML, вы заметите разницу:

Emoji Вход:

<w:r w:rsidR="003814F5">
  <w:rPr>
    <mc:AlternateContent>
      <mc:Choice Requires="w16se">
        <w:rFonts w:ascii="Segoe UI Emoji" w:hAnsi="Segoe UI Emoji"/>
      </mc:Choice>
      <mc:Fallback>
        <w:rFonts w:hint="eastAsia"/>
      </mc:Fallback>
    </mc:AlternateContent>
  </w:rPr>
  <mc:AlternateContent>
    <mc:Choice Requires="w16se">
      <w16se:symEx w16se:font="@SimHei" w16se:char="1F44D"/>
    </mc:Choice>
    <mc:Fallback>
      <w:t>👍</w:t>
    </mc:Fallback>
  </mc:AlternateContent>
</w:r>

Вход в меню (символ):

<w:r w:rsidR="003814F5">
  <w:rPr>
    <w:rFonts w:ascii="Segoe UI Emoji" w:hAnsi="Segoe UI Emoji"/>
  </w:rPr>
  <w:t xml:space="preserve"> is not 👍</w:t>
</w:r>

Строка <w16se:symEx w16se:font="@SimHei" w16se:char="1F44D"/> является ключевым отличием. Нормальный (Menu → Insert Symobol) эмодзи используется как запасной вариант.

Кажется, только Word имеет проблему. Я попробовал тот же ввод с панели смайликов в Excel (и PowerPoint), и я получил правильные значения в отладке ?? что переводит в кодовую точку Unicode U+1F44D как в Excel, так и при копировании обратно в Word.

Ответ 3

На "компьютере 1" я мог найти этот обходной путь (но он не работает на "компьютере 2"): можно восстановить правильное "значение" символа, используя "вырезать" + "вставить" следующим образом:

Sub test()
    Dim text As String
    Dim length As Integer
    Dim arrBytes() As Byte
    Dim chara As Range
    Set chara = ActiveDocument.Range.Characters(1)
    Call chara.Cut
    Call chara.Paste
    text = ActiveDocument.Range.Characters(1).text
    length = Len(ActiveDocument.Range.Characters(1).text)
    arrBytes = ActiveDocument.Range.Characters(1).text
End Sub

Затем вы получите ожидаемое значение:

text = ??
length = 2
arrBytes = { 61, 216, 77, 220 }

Чтобы автоматически "исправить" весь документ, этот простой код работает:

Sub test()
    Dim wholestory As Range
    Set wholestory = ActiveDocument.Range
    Call wholestory.Cut
    Call wholestory.Paste
End Sub

Ответ 4

Сандра, я попытался записать макрос вызова меню вставки смайликов Windows, и я получил следующее:

Selection.TypeText Text:=ChrW(55357) & ChrW(56397)

Затем я записал макрос через символ вставки:

Selection.InsertSymbol Font:="Segoe UI Emoji", CharacterNumber:=-10179, Unicode:=True
Selection.InsertSymbol Font:="Segoe UI Emoji", CharacterNumber:=-9139, Unicode:=True.

И самое интересное для меня - ЭТО РАЗЛИЧНЫЕ ХАРАКТЕРЫ в моем MS Word. Один ориентирован вправо-влево и полностью черного цвета, и наоборот. Таким образом, вставленные этими способами символы, кажется, совершенно разные