Question

我想通过VBA将Word文件中的所有突出显示和阴影文本复制到Excel文件中，并且具有相同颜色。

我只能逐字复制突出显示的文本。但是实际的任务是将所有突出显示和加阴影的文本复制到Excel，并根据Excel中的颜色对所有数据进行排序。

我使用此代码，仅在单词之间复制时效果很好，但是没有格式化该代码，仅复制文本而不显示颜色；

https://www.mydom.com

从明暗转换为突出显示的代码：

https://mydom.com

Answer 1

可以尝试这样的事情

编辑：尝试通过使用两个发现包括阴影文本（任何颜色）和突出显示文本的提取。采用以下解决方法

要查找（任何颜色的阴影文本），将对.Font.Shading.BackgroundPatternColor = wdColorAutomatic执行查找，并且将选择范围之外的范围选为阴影文本和颜色。当选择包含纯文本字符时以某种方式粗略执行的方法，但是当选择包含非文本字符（即段落标记等）时仍然会选择错误的颜色值。否则，它会达到预期的效果。否则，总是有另一个选择可以循环访问文档中的所有字符。但是该选项被忽略了，因为它对于大型文档来说非常慢且不切实际。
由于我找不到将HighlightColorIndex转换为RGB颜色值的简单方法（或属性），因此将相同的方法应用于一个字符的Font.ColorIndex，然后提取为Font.Color

所以最终解决方案变得凌乱不堪，而且有些粗糙，我一点也不满意，并且邀请专家就这些方面的简单直接解决方案提供更多答案。

代码：

Option Explicit
Sub ExtractHighShadeText()
Dim Exc As Excel.Application
Dim Wb As Excel.Workbook
Dim Ws As Excel.Worksheet
Dim s As String, Rw As Long
Set Exc = CreateObject("Excel.Application")
Exc.Visible = True
Set Wb = Exc.Workbooks.Add
Set Ws = Wb.Sheets(1)
Rw = 0

Dim Rng As Range, StartChr As Long, EndChr As Long, OldColor As Long, Clr As Long
''''''''''''''''''''HiLight''''''''''''''''''
Set Rng = ActiveDocument.Characters(1)
OldColor = Rng.Font.Color
Selection.HomeKey Unit:=wdStory

        With Selection.Find
            .ClearFormatting
            .Text = ""
            .Highlight = True
            Do While .Execute

            'These two line Converting HighlightColorIndex to RGB Color
            Rng.Font.ColorIndex = Selection.Range.HighlightColorIndex
            Clr = Rng.Font.Color

            Rw = Rw + 1
            Ws.Cells(Rw, 1).Value = Selection.Text
            'Ws.Cells(Rw, 1).Interior.ColorIndex = Selection.Range.HighlightColorIndex
            Ws.Cells(Rw, 1).Interior.Color = Clr
            'For sorting on HighlightColorIndex
            'Ws.Cells(Rw, 2).Value = Selection.Range.HighlightColorIndex
            'For sorting on HighlightColorIndex RGB value
            Ws.Cells(Rw, 2).Value = Clr
            Loop
        End With
Rng.Font.Color = OldColor
'''End Hilight''''''''''''''''''''''''''''''

'WorkAround used for converting highlightColorIndex to Color RGB value
StartChr = 1
EndChr = 0
Set Rng = ActiveDocument.Characters(1)

Selection.HomeKey Unit:=wdStory
        With Selection.Find
            .ClearFormatting
            .Text = ""
            '.Highlight = True
            .Font.Shading.BackgroundPatternColor = wdColorAutomatic

            Do While .Execute
              EndChr = Selection.Start
              Debug.Print Selection.Start, Selection.End, StartChr, EndChr, IIf(EndChr > StartChr, "-OK", "")

              If EndChr > StartChr Then
              Set Rng = ActiveDocument.Range(Start:=StartChr, End:=EndChr)
              Clr = Rng.Font.Shading.BackgroundPatternColor
              Rw = Rw + 1
              Ws.Cells(Rw, 1).Value = Rng.Text
              Ws.Cells(Rw, 1).Interior.Color = Clr
              Ws.Cells(Rw, 2).Value = Clr
              End If
              StartChr = Selection.End
            Loop

              If EndChr > StartChr Then
              Set Rng = ActiveDocument.Range(Start:=StartChr, End:=EndChr)
              Clr = Rng.Font.Shading.BackgroundPatternColor
              Rw = Rw + 1
              Ws.Cells(Rw, 1).Value = Rng.Text
              Ws.Cells(Rw, 1).Interior.Color = Clr
              Ws.Cells(Rw, 2).Value = Clr
              End If

        End With


    If Rw > 1 Then
    Ws.Range("A1:B" & Rw).Sort Key1:=Ws.Range("B1"), Order1:=xlAscending, Header:=xlNo
    Ws.Range("B1:B" & Rw).ClearContents
    End If
End Sub

我想通过VBA将所有突出显示和阴影的文本以及颜色从Word文件复制到Excel

1 个答案: