תאריך ההודעה המקורית: 28/08/2024 14:14
מלבד קיצור הדרך הנ"ל, הכנתי מאקרו להזרחות שעושה עוד פעולה, אם אין משהו
מושחר הוא מחפש את ההזרחה הבאה. ואז בלחיצה נוספת אפשר לבטל אותה.
זה מאקרו די מורכב.
הנה הוא:
Sub הדגשצהוב()
' Check if text is selected
If Selection.Type = wdSelectionIP Then
' No text selected, search and select next highlighted text
Dim rng As Range
Dim foundInMainDoc As Boolean
Dim foundInFootnote As Boolean
foundInMainDoc = False
foundInFootnote = False
Set rng = ActiveDocument.Range
' Set the starting point to the current selection
rng.Start = Selection.End
' Check if selection is in footnotes
If Selection.StoryType = wdFootnotesStory Then
' Search in footnotes first
foundInFootnote = FindNextHighlightInFootnotes(Selection.End)
End If
' If not found in footnotes, search in main document
If Not foundInFootnote Then
With rng.Find
.ClearFormatting
.Highlight = True
.Wrap = wdFindStop
.Forward = True
.Execute
End With
If rng.Find.Found Then
rng.Select
foundInMainDoc = True
Else
' If not found in main document, check in footnotes
foundInFootnote = FindNextHighlightInFootnotes(0)
End If
End If
' If still not found, search from the beginning of the document
If Not foundInMainDoc And Not foundInFootnote Then
rng.Start = 0
rng.End = Selection.End
With rng.Find
.ClearFormatting
.Highlight = True
.Wrap = wdFindStop
.Forward = True
.Execute
End With
If rng.Find.Found Then
rng.Select
foundInMainDoc = True
Else
' If still not found, search footnotes from the beginning
foundInFootnote = FindNextHighlightInFootnotes(0)
End If
End If
' If no highlight found in both main document and footnotes
If Not foundInMainDoc And Not foundInFootnote Then
MsgBox "אין עוד טקסט מסומן עד סוף המסמך, כולל הערות שוליים."
End If
Else
' Check if the selected range is already highlighted
If Selection.Range.HighlightColorIndex = wdYellow Then
' If highlighted, remove the highlighting
Selection.Range.HighlightColorIndex = wdNoHighlight
Selection.MoveRight Unit:=wdCharacter, Count:=1
Else
' If not highlighted, apply yellow highlighting
Options.DefaultHighlightColorIndex = wdYellow
Selection.Range.HighlightColorIndex = wdYellow
End If
End If
End Sub
Function FindNextHighlightInFootnotes(startPosition As Long) As Boolean
Dim ftNote As Footnote
Dim ftRng As Range
FindNextHighlightInFootnotes = False
For Each ftNote In ActiveDocument.Footnotes
Set ftRng = ftNote.Range
If ftRng.End > startPosition Then
ftRng.Start = Max(ftRng.Start, startPosition)
With ftRng.Find
.ClearFormatting
.Highlight = True
.Wrap = wdFindStop
.Forward = True
.Execute
End With
If ftRng.Find.Found Then
ftRng.Select
FindNextHighlightInFootnotes = True
Exit Function
End If
End If
Next ftNote
End Function
Function Max(value1 As Long, value2 As Long) As Long
If value1 > value2 Then
Max = value1
Else
Max = value2
End If
End Function
--
