תאריך ההודעה המקורית: 28/05/2024 23:29
לאחר שימוש במאקרו ההזרחה החדש שפירסמתי לפני יומיים,
גיליתי באג.
כשעמדתי בהערות השוליים וחיפשתי את ההזרחה הבאה, הוא קפץ להזרחה הראשונה
בהערות השוליים.
לאחר בדיקות נראה שעכשיו זה מתוקן ומושלם.
וזרח עליו השמש.
הנה המאקרו המתוקן:
Sub הדגשצהוב()
' Check if text is selected
If Selection.Type = wdSelectionIP Then
' No text selected, search and select next highlighted text
Dim rng As Range
Set rng = ActiveDocument.Range
' Set the starting point to the current selection
rng.Start = Selection.End
' Find the next highlighted text in the main document
With rng.Find
.ClearFormatting
.Highlight = True
.Wrap = wdFindStop
.Forward = True
.Execute
End With
If rng.Find.Found Then
rng.Select
Else
' If not found in main document, check in footnotes
Dim ftNote As Footnote
Dim ftRng As Range
Dim foundInFootnote As Boolean
foundInFootnote = False
' Adjust the range for searching footnotes
Dim currentPosition As Long
currentPosition = Selection.End
For Each ftNote In ActiveDocument.Footnotes
Set ftRng = ftNote.Range
If ftRng.End > currentPosition Then
ftRng.Start = Max(ftRng.Start, currentPosition)
With ftRng.Find
.ClearFormatting
.Highlight = True
.Wrap = wdFindStop
.Forward = True
.Execute
End With
If ftRng.Find.Found Then
ftRng.Select
foundInFootnote = True
Exit For
End If
End If
Next ftNote
If Not foundInFootnote Then
MsgBox "אין עוד טקסט מסומן עד סוף המסמך, כולל הערות שוליים."
End If
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 Max(value1 As Long, value2 As Long) As Long
If value1 > value2 Then
Max = value1
Else
Max = value2
End If
End Function
--
