בירור | האם יש דרך להוספת הערות סקירה על הערות שוליים וסיום?

[צבי צ]

@שמעון-פרידנן
בדקתי, כנ"ל.

[שמעון פרידנן]

פוסט זה נמחק!

[צבי צ]

@שמעון-פרידנן
בדקתי שוב, בהערת שוליים עובד ובהערת סיום שגיאה.

[יעב"ץ]

@צבי-צ
אם בכל אופן תוכל - זה יעזור לי מאד.

[יעב"ץ]

@צבי-צ
אשמח אם תוכל, וכן להוסיף שיעבוד גם בתצוגת טיוטה ולא רק בתצוגת הדפסה.

Spoiler

אני משתמש דווקא בזה ולא בשני.

[צבי צ]

@יעב-ץ
מה שנוח לך, כתבתי שלדעתי מה שכתב הרב @שמעון-פרידנן יותר מקצועי.

אצלי זה תקין, תבדוק אצלך ותעדכן.

Sub הערת_סקירה_בהערת_שוליים()
    Dim cmt As Comment
    Dim anchor As Range
    Dim txt As String
    Dim panesBefore As Long
    Dim st As Long
    Dim pos As Long
    Dim lo As Long, hi As Long, mid As Long

    txt = InputBox("הקלד את הערת הסקירה:", "הערת סקירה")
    If txt = "" Then Exit Sub

    panesBefore = ActiveWindow.Panes.Count
    st = Selection.StoryType
    pos = Selection.Start

    ' הדגשת הטקסט המסומן (בתוך הערת השוליים/הסיום)
    If Selection.Start <> Selection.End Then
        Selection.Range.HighlightColorIndex = wdYellow
    End If

    Select Case st
        Case wdFootnotesStory
            lo = 1: hi = ActiveDocument.Footnotes.Count
            Do While lo <= hi
                mid = (lo + hi) \ 2
                If pos < ActiveDocument.Footnotes(mid).Range.Start - 1 Then
                    hi = mid - 1
                ElseIf pos > ActiveDocument.Footnotes(mid).Range.End Then
                    lo = mid + 1
                Else
                    Set anchor = ActiveDocument.Footnotes(mid).Reference
                    Exit Do
                End If
            Loop

        Case wdEndnotesStory
            lo = 1: hi = ActiveDocument.Endnotes.Count
            Do While lo <= hi
                mid = (lo + hi) \ 2
                If pos < ActiveDocument.Endnotes(mid).Range.Start - 1 Then
                    hi = mid - 1
                ElseIf pos > ActiveDocument.Endnotes(mid).Range.End Then
                    lo = mid + 1
                Else
                    Set anchor = ActiveDocument.Endnotes(mid).Reference
                    Exit Do
                End If
            Loop

        Case wdMainTextStory
            Set anchor = Selection.Range
            If anchor.Start = anchor.End Then anchor.MoveEnd wdCharacter, 1
    End Select

    If anchor Is Nothing Then
        MsgBox "הסמן צריך להיות בגוף המסמך, בהערת שוליים או בהערת סיום.", vbExclamation
        Exit Sub
    End If

    Set cmt = ActiveDocument.Comments.Add(anchor)
    cmt.Range.Text = txt

    ' סגירת חלונית הסקירה שנפתחה (בתצוגת טיוטה) - ורק אותה
    If ActiveWindow.Panes.Count > panesBefore Then
        ActiveWindow.Panes(ActiveWindow.Panes.Count).Close
    End If
End Sub

[יעב"ץ]

@צבי-צ
דבר ראשון - תודה!
שנית, זה עובד.
שלישית, הקודם היה הרבה הרבה יותר מהיר, זה חושב המון זמן.

[צבי צ]

@יעב-ץ
תבדוק האם זה יותר מהיר.

בכל מקרה בקובץ גדול עם הרבה הערות תמיד זה נתקע,
עיין במה ש @אוריי כתב פה ובהמשך השרשור.

https://mitmachim.top/post/1270021

Sub הערת_סקירה_בהערת_שוליים()
    Dim cmt As Comment
    Dim anchor As Range
    Dim txt As String
    Dim panesBefore As Long
    Dim st As Long
    Dim rngSel As Range

    txt = InputBox("הקלד את הערת הסקירה:", "הערת סקירה")
    If txt = "" Then Exit Sub

    Application.ScreenUpdating = False

    panesBefore = ActiveWindow.Panes.Count
    st = Selection.StoryType
    Set rngSel = Selection.Range

    If Selection.Start <> Selection.End Then
        rngSel.HighlightColorIndex = wdYellow
    End If

    Select Case st
        Case wdFootnotesStory
            Set anchor = rngSel.Footnotes(1).Reference
        Case wdEndnotesStory
            Set anchor = rngSel.Endnotes(1).Reference
        Case wdMainTextStory
            Set anchor = rngSel.Duplicate
            If anchor.Start = anchor.End Then anchor.MoveEnd wdCharacter, 1
    End Select

    If anchor Is Nothing Then
        Application.ScreenUpdating = True
        MsgBox "הסמן צריך להיות בגוף המסמך, בהערת שוליים או בהערת סיום.", vbExclamation
        Exit Sub
    End If

    Set cmt = ActiveDocument.Comments.Add(anchor)
    cmt.Range.Text = txt

    If ActiveWindow.Panes.Count > panesBefore Then
        ActiveWindow.Panes(ActiveWindow.Panes.Count).Close
    End If

    Application.ScreenUpdating = True
End Sub

[יעב"ץ]

@צבי-צ
אכן, מעט יותר טוב.
תודה גדולה ועצומה!

[יעב"ץ]

@צבי-צ

@צבי-צ כתב:

בכל מקרה בקובץ גדול עם הרבה הערות תמיד זה נתקע,
עיין במה ש @אוריי כתב פה ובהמשך השרשור.

אני מריץ את זה בפריסת טיוטה, וזה איטי.