هل ممكن ماكرو يحتوي على نسخ النص المحدد ونسخ رقم الصفحة معه ليتم اللصق في ملف جديد

[محمد سيد٧٩]

هل ممكن ماكرو يحتوي على نسخ النص المحدد ونسخ رقم الصفحة معه ليتم اللصق في ملف جديد

شكرا جزيلا

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

نعم، تفضل:

'
'ماكرو لإضافة مجموعة كلمات، أو جمل لاستخراجها آخر الملف مع أرقام الصفحات الموجودة فيها
'

Dim strList  As String
Dim Coll As Collection
Dim oRng As Range
Dim vName As Variant
Dim i As Integer, j As Integer

ss = InputBox("أدخل الكلمات التي تريد فهرستها آخر الملف مفصولة بفاصلة ")

strList = ss

vName = Split(strList, "،")
For i = 0 To UBound(vName)
Set Coll = New Collection
Set oRng = ActiveDocument.Range
oRng.End = ActiveDocument.Range.Paragraphs(ActiveDocument.Range.Paragraphs.Count - i).Range.START
With oRng.Find
Do While .Execute(vName(i))
Coll.Add oRng.Information(wdActiveEndPageNumber)
Loop
End With
ActiveDocument.Range.InsertAfter vbCr & vName(i) & ": "
For j = 1 To Coll.Count
ActiveDocument.Range.InsertAfter Coll(j)
If j < Coll.Count Then ActiveDocument.Range.InsertAfter ", "
Next j
Next i
lbl_Exit:
Set oRng = Nothing
Set Coll = Nothing
Selection.EndKey Unit:=wdStory
Beep
Exit Sub
End Sub