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

【问题标题】：VBA MS-WORD load all the yellow highlighted texts in variable arrayVBA MS-WORD 加载变量数组中所有黄色突出显示的文本
【发布时间】：2017-11-03 20:50:47
【问题描述】：

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

我找到了这个链接：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 elit。 Curabitur iaculis vehicula arcu, accumsan facilisis eros sagittis sed。 Duis sit amet diam sit amet magna pharetra molestie。 Cras sagittis lacus non tortor accumsan accumsan commodo at mi。 Ut ipsum nunc, suscipit at elit quis, auctor rutrum diam。 Mauris vel dictum dolor。 Quisque 第二个文本是黄色突出显示 porta a purus in sodales。 Pellentesque accumsan ac Tellus a molestie。 Duis tempor sapien enim, eu 这另一个文本也被突出显示 sollicitudin turpis volutpat sat amet。 Ut libero dui, dapibus in vulputate vitae, aliquet vel turpis。 Donec nec congue est. In enim turpis, scelerisque id condimentum ac, porta quis Tellus。

然后： HltText(1)="此文本为黄色突出显示" HltText(2)="他的第二个文本是黄色突出显示" 等等……

【问题讨论】：

标签： vba replace ms-word highlight information-extraction

【解决方案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

结束子

【讨论】：

谢谢。有用。看起来你忘记了循环中的 intindex=intindex+1 但我明白了。它完美地工作。多谢。从那以后，我可以开始我更艰巨的任务，即使用数组中的单词（黄色单词）在文档的其余部分中查找这些单词，这些单词后面可能跟一个参考号。再次感谢

【解决方案2】：

我想发布另一个不涉及使用字符的 FIND 的替代解决方案。

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 颜色中包含一个用于突出显示的按钮。你知道我的意思。

【讨论】：