(مهم جدا للفهرسة) استخراج جميع الألوان من المستند عدا اللون الأسود:

[أبو عاصم المصري]

كثيرا ما يحتاج الباحث إلى استخراج كلمات أو جمل لها لون معين للنظر فيها، أو فهرستها.

وهذا الماكرو يقوم باستخراج كل العبارات الملونة بأي لون عدا اللون الأسود، ويضعها في آخر الملف مع أرقام الصفحات.

فتستطيع مثلا أن تجعل كل الأعلام باللون الأحمر، والقبائل بالأخضر، والأماكن بالأزرق، وهكذا أثناء تصفحك للمستند.

وفي آخر العمل تقوم باستخراج كل هذه الألوان دفعة واحدة مع أرقام صفحاتها.

وهذا الماكرو:

Dim char As Range

For Each char In ActiveDocument.Characters
If char.Font.Color <> wdColorAutomatic And char.Font.Color <> wdColorBlack Then     ' إذا كان لون النص غير تلقائي أو أسود
char.HighlightColorIndex = wdTurquoise

End If
Next

Dim dic As Object
Dim r As Range, k
Dim s As String, p As Long
Dim Tbl As Table, n As Long

Set dic = CreateObject("scripting.dictionary")

Set r = ActiveDocument.Content
r.Collapse
With r.Find
.Highlight = True
'.Font.ColorIndex = strFontColor
Do While .Execute
s = Trim(r.Text)
If Len(s) > 1 Then
If Not dic.Exists(s) Then
Set dic(s) = CreateObject("scripting.dictionary")
End If
p = r.Information(wdActiveEndPageNumber)
dic(s)(p) = Empty
End If
Loop
End With

If dic.Count = 0 Then Exit Sub

Set r = ActiveDocument.Bookmarks("\EndOfDoc").Range

Set Tbl = ActiveDocument.Tables.Add(r, dic.Count, 2)

For Each k In dic
n = n + 1
Tbl.Cell(n, 1).Range.Text = k
Tbl.Cell(n, 2).Range.Text = Join(dic(k).Keys, "، ")
Next

Selection.EndKey Unit:=wdStory
Beep
End Sub