@MOSHES
תודה על הנדיבות לב אני בעזה"י אראה יותר מדיוק איך להשתמש בהם
יישר כח
ולגבי המקרו השלישי
חבר הביא לי מהAI פקודה שעושה חיפוש של מספר שמופיע כפול במסמך
למשל 11 ואחרי כן יש קטע שמתחיל ג"כ ב11 הוא הופך את הראשון להפניה להערת שוליים ואת השני להערת שוליים ומסמן את מה שהוא הפנה עם סימון צהוב ככה תוכל לעבור ולראות
מצו"ב אשמח לתגובה
Sub LinkNumbersForce()
Dim doc As Document
Dim dict As Object
Dim regEx As Object, matches As Object, m As Object
Dim numStr As String
Dim pairsCount As Integer
Set doc = ActiveDocument
Set dict = CreateObject("Scripting.Dictionary")
Set regEx = CreateObject("VBScript.RegExp")
pairsCount = 0
regEx.Global = True
regEx.Pattern = "\d+"
' שלב 1: איסוף מספרים
Set matches = regEx.Execute(doc.Content.Text)
For Each m In matches
numStr = m.Value
If dict.Exists(numStr) Then
dict(numStr) = dict(numStr) + 1
Else
dict.Add numStr, 1
End If
Next m
' שלב 2: ביצוע הקישור
For Each Key In dict.Keys
If dict(Key) = 2 Then
Dim rng As Range
Set rng = doc.Content
With rng.Find
.ClearFormatting
.Text = Key
.MatchWildcards = False
.Forward = True
If .Execute Then
Dim firstOccurrence As Range
Set firstOccurrence = rng.Duplicate
Dim secondRng As Range
Set secondRng = doc.Range(rng.End, doc.Content.End)
With secondRng.Find
.Text = Key
If .Execute Then
Dim noteParagraph As Range
Set noteParagraph = secondRng.Paragraphs(1).Range
Dim noteText As String
noteText = Trim(Replace(noteParagraph.Text, Key, "", 1, 1))
' יצירת ההערה
Dim fn As Footnote
Set fn = doc.Footnotes.Add(Range:=firstOccurrence, Text:=noteText)
fn.Reference.HighlightColorIndex = wdYellow
' מחיקה
noteParagraph.Delete
firstOccurrence.Delete
pairsCount = pairsCount + 1
End If
End With
End If
End With
End If
Next Key
MsgBox "הסתיים! נמצאו וקושרו " & pairsCount & " זוגות של מספרים."
End Sub