Word VBA 程序将 Emoji 字符（4 个字节）读取为“12”

Question

我创建了一个文档，其中只有一个“赞”Emoji（Unicode 代码点 U+1F44D），我通过标准 Windows+; 快捷方式插入：

但我无法获得其使用 VBA 的实际代码点。

我得到这些值（调试）：

text = 12
length = 2
arrBytes = { 49, 0, 50, 0 }

使用以下子程序：

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

但如果我通过菜单 Insert > Symbol > Font "Segoe UI Emoji" > U+1F44D 插入了相同的 Emoji (竖起大拇指），相同的 Sub 过程得到了我期望的值（在调试中；?? 不是“真实”字符，它们是 surrogate code points 单独没有任何意义）：

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

（供参考，此code 将这两个字符解码为&#x1F44D）

如果使用 Windows+; 插入 Emoji，如何确定实际字符？（请用户选择上述解决方法是不属于我的问题）

附录 5 月 26 日：@Florent B. 的解决方案适用于我所有的 3 台计算机 (ActiveDocument.Content.InsertXML ActiveDocument.Content.XML)。重新加载 XML 可能会对 VBA 程序产生影响，例如它会重新编号图像“形状 ID”，但这是另一回事。

ADDENDUM May 22nd：对于使用 Windows+; 添加的符号，我可以找到正确的值（4 bytes { 61, 216 , 77, 220 }) 只在文档 Range 对象的XML 属性中，但它要求我解析整个 XML 并确定哪些 XML 字符对应 Range 对象的哪些位置，不幸的是我觉得它需要很多知识或假设。这是我可以看到 4 个字节的 XML 部分（<w:t>??</w:t> 其中 ?? 对应于 4 个字节）：

  <?xml version="1.0" standalone="yes"?>
  <?mso-application progid="Word.Document"?>
  <w:wordDocument ...>
    ... (around 23.000 characters)
    <w:body>
      <wx:sect>
        <w:p wsp:rsidR="002703DB" wsp:rsidRDefault="003926FB">
          <w:r>
            <w:rPr>
              <w:rFonts w:ascii="Segoe UI Emoji" w:h-ansi="Segoe UI Emoji"/>
              <wx:font wx:val="Segoe UI Emoji"/>
            </w:rPr>
            <w:t>??</w:t>
          </w:r>
        </w:p>
        <w:sectPr wsp:rsidR="002703DB" wsp:rsidSect="002849CD"><w:pgSz w:w="11906"
                w:h="16838"/><w:pgMar w:top="1417" w:right="1417" w:bottom="1417"
                w:left="1417" w:header="708" w:footer="708" w:gutter="0"/><w:cols
                w:space="708"/><w:docGrid w:line-pitch="360"/></w:sectPr>
      </wx:sect>
    </w:body>
  </w:wordDocument>

当我将表情符号作为符号插入时，XML 几乎相同，还有 2 个“rFonts”：

    <w:body>
      <wx:sect>
        <w:p wsp:rsidR="00CD420D" wsp:rsidRDefault="00CD420D">
          <w:r>
            <w:rPr>
              <w:rFonts w:ascii="Segoe UI Emoji" w:fareast="Segoe UI Emoji"
                    w:h-ansi="Segoe UI Emoji" w:cs="Segoe UI Emoji"/>
              <wx:font wx:val="Segoe UI Emoji"/>
            </w:rPr>
            <w:t>??</w:t>
          </w:r>
        </w:p>
        <w:sectPr wsp:rsidR="00CD420D" wsp:rsidSect="002849CD"><w:pgSz w:w="11906"
                w:h="16838"/><w:pgMar w:top="1417" w:right="1417" w:bottom="1417"
                w:left="1417" w:header="708" w:footer="708" w:gutter="0"/><w:cols
                w:space="708"/><w:docGrid w:line-pitch="360"/></w:sectPr>
      </wx:sect>
    </w:body>
  </w:wordDocument>

PS：我可以重现问题的计算机/软件：

• 计算机 1（联想 X230）：
  • MS Word Office 365 1904 (16.0.11601.20174) 32 位，Windows 10 Professional 10.0.17763 x64
  • 同样升级到 Office 365 1907 16.0.11901.20176、MSO (16.0.11901.20070) 32 位、Windows 10 Professional 1809 17763.652 x64
• 计算机 2：
  • MS Word Office 365 1904 (16.0.11601.20184) 64 位，Windows 10 Professional 1809 17763.503 x64
• 计算机 3（戴尔）：
  • MS Word Office 365 ProPlus 1808 (16.0.10730.20334) 64 位，Windows 10 Enterprise 10.0.17763 x64

Answer 1

我希望这会有所帮助：在上面@SandraRossi 的 cmets 的基础上，似乎来自表情符号面板的输入未正确转换为其代理代码点。如果您将包含两个符号的文档（一个来自表情符号面板，另一个来自菜单，如您所述）保存为 XML 文档，您会注意到不同之处：

表情符号输入：

<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"/> 行是这里的关键区别。普通（菜单 -> 插入符号）表情符号用作后备。

似乎只有 Word 有问题。我在 Excel（和 PowerPoint）上尝试了相同的表情符号面板输入，并且在调试 ?? 中得到了正确的值，它在 Excel 中和复制回 Word 时都转换为 Unicode 代码点 U+1F44D。

Answer 2

这是我最终的信念和发现。

根据 AAA 在 Excel、Powerpoint 和 Word 上执行的测试，这可能是 MS Word VBA 中的一个错误。有些人没有这个错误（cf cmets）。

VBA 对象为表情符号提供了无效值，但 XML 属性是正确的。 XML 过于复杂，难以解析，因此 Florent B. 在 cmets 中找到了最简单的解决方法，即“从自身重新创建文档”：

ActiveDocument.Content.InsertXML ActiveDocument.Content.XML

不幸的是，就我个人而言，它可能会产生一些附带影响，例如形状 ID 被重新编号。

所以，我扩展了上面的代码，只更正了原始文档中的表情符号，其余的保持不变，通过：

• 将 XML 复制到新文档，
• 然后解析新文档中文本长度大于 1 的每个字符（即 Unicode 基本多语言平面之外的字符，也包含表情符号和许多其他字符），
• 同时解析原始文档（假设字符应与新文档中的字符顺序相同，并且它们的文本长度相同），
• 将这些字符从新文档复制回原始文档，
• 关闭新文档。

好的，宏运行时间更长，但我找不到更好的解决方案。

这是我的代码，简化（你可能会惊讶于Range对象的无用集合，其中每个Range都是一个Character对象，实际上我没有提供函数Split_Into_Ranges的原始代码，这很多更大但更快，但它工作并很好地演示了 sub 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