תיקון באג במאקרו ההזרחה

[מהדיר ספרים - ארכיון]

תאריך ההודעה המקורית: 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

--