VBA MS-WORD 加载变量数组中所有黄色突出显示的文本

Question

我想要运行一个宏，它可以从文档中提取所有黄色突出显示的文本，并将所有这些突出显示的文本传递到一个数组变量中。

我找到这个 link：How to perform a selective extraction of text highlighted in yellow from an MS Word document?

但建议的解决方案不起作用并且不完全相同。

所以基本上逻辑是：

查看所有文件计算有多少突出显示的文本

Dim CountYellow as integer
Dim HltText as variant
'i dont know how to do this next:
countyellow= number of highlighted texts
redim HltText(1 to countyellow)
for i=1 to countyellow
'I dont know how to do this next:
FIND THE NEXT YELLOW HIGHLIGHTED TEXT
HltText(i)= HIGHLIGHTED TEXT
next i

非常感谢

PS；在我重新阅读我的问题后，我想在此处添加以进行澄清。文本将是这样的：

Lorem ipsum dolor sit amet，此文本已黄色突出显示 consectetur adipiscing elite。 Curabitur iaculis 车拱，accumsan facilisis eros sagittis 口渴。 Duis sit with diam sit with magna pharetra molestie。 Cras sagittis lacus non tortor accumulation accumulation chestor at me。出乎意料，怀疑精英问题，作者 rutrum diam。莫里斯周围的格言痛苦。 Quisque 这第二个文本是黄色突出显示的 苏打水里有脓。 Pellentesque 指责 ac tellus 滋扰。如果您想知道，我会在这篇 另一篇文章中突出显示 sunlight turpis volutpat sit amet。 Out libero dui, dapibus in vulputate vitae, aliquet vel turpis. Donec nec congue 是。 In some turquoise, scelerisque id condimentum ac, porta quis tellus.

然后： HltText(1)="THIS TEXT IS YELLOW HIGHLIGHTED" HltText(2)="HIS SECOND TEXT IS YELLOW HIGHLIGHTED" 等....

Answer 1

也许是这样的？

Sub Highlights()
'
' Highlights Macro
'
Dim rng As Variant
Dim strResults(1000) As String
Dim intIndex As Integer

Set wordapp = CreateObject("word.Application")
    wordapp.documents.Open "C:\filename.docx"
    wordapp.Visible = True

Set rng = wordapp.ActiveDocument.Content
rng.Find.Forward = True
rng.Find.Highlight = True
rng.Find.Execute

intIndex = 0
Do While rng.Find.Found = True
    Debug.Print (rng.Text)
    strResults(intIndex) = rng.Text
    rng.Find.Execute
Loop

结束子

Answer 2

我想 post 另一个不涉及使用字符查找的替代解决方案。

Dim YellowWord(1 To 100) As String
Dim i As Integer, j As Integer, k As Integer  'counter
i = 0

With Selection
.HomeKey Unit:=wdStory
While (ActiveDocument.Range.End - 1) > .Range.End
strText = ""
' mark first character of the current word
.MoveRight Unit:=WdUnits.wdCharacter, Count:=1, Extend:=wdExtend
If .Characters(1).FormattedText.HighlightColorIndex = m_lngFindColor Then
Do
' save charcater
strText = strText & .Text
' next character
.MoveRight Unit:=WdUnits.wdCharacter, Count:=1, Extend:=wdMove
Loop While .Characters(1).FormattedText.HighlightColorIndex = m_lngFindColor And ((ActiveDocument.Range.End - 1) > Selection.Range.End)
Debug.Print strText
i = i + 1
YellowWord(i) = strText
Debug.Print "YellowWord(" & i & ")= "; yellowWord(i)
End If
.Move WdUnits.wdWord, 1
Wend
End With

效果很好。

注意用户不要使用任何其他黄色。我建议在特定的 vbyellow 颜色中包含一个用于突出显示的按钮。你知道我的意思。

VBA MS-WORD 加载变量数组中所有黄色突出显示的文本

VBA MS-WORD load all the yellow highlighted texts in variable array

vba

replace

ms-word

highlight

information-extraction