Question

我创建了一个文档，其中只有一个“ Thumb up” 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

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

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

（有关信息，此code将两个字符解码为&#x1F44D）

如何确定是否使用 Windows + ; 插入了表情符号？（要求用户选择上述解决方法是不属于我的问题）

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

附录5月22日：对于在 Windows + ; 中添加的符号，我可以找到正确的值（4个字节，{61，216 ，77，220}）仅在文档Range对象的XML属性中，但是它要求我解析整个XML并确定哪些XML字符对应于Range对象的哪个位置，不幸的是，我觉得它需要一个很多知识或假设。这是XML的一部分，可以看到4个字节（<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 几乎是相同的，还有另外两个“ 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：MS Word Office 365 1904（16.0.11601.20174）32位，Windows 10 Professional 10.0.17763 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的上述评论为基础，似乎表情符号面板中的输入未正确转换为其替代代码点。如果您将包含两个符号的文档（一个来自Emoji面板，另一个来自菜单，如您所描述）保存为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。 / p>

Answer 2

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

根据AAA在Excel，Powerpoint和Word上进行的测试，这可能是MS Word VBA中的错误。有些人没有此错误（请参见注释）。

VBA对象为表情符号提供了无效的值，但XML属性正确。 XML太复杂而无法轻松解析，因此Florent B.在注释中找到了最简单的解决方法，其中包括“从自身重新创建文档”：

ActiveDocument.Content.InsertXML ActiveDocument.Content.XML

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

因此，我将上面的代码扩展为仅纠正原始文档中的表情符号字符，其余部分则保持不变，方法是：

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

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

这是我的代码，经过简化（您可能会对Range对象的无用集合感到惊讶，其中每个Range是一个Character对象，实际上我没有提供函数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

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

2 个答案: