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

[צבי צ]

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

Option Explicit

'=============================================================
' הערות סקירה על הפניות להערות שוליים / הערות סיום
' מודל: ראש אחד לכל הערה + תגובותיו.
' צביעה צהובה של המילים המסומנות (רק במסמך, לא בטופס).
'=============================================================

'-------------------------------------------------------------
' סעיף 1: נקודת כניסה (מכיר את הטופס)
'-------------------------------------------------------------
Private m_CurrentForm As frmComments

Public Sub ShowFootnoteComments()
    Dim idx As Long, isEnd As Boolean
    If Not CurrentFootnoteIndex(idx, isEnd) Then
        MsgBox "יש להציב את הסמן בתוך הערת שוליים או הערת סיום.", _
               vbInformation, "הצגת הערות סקירה"
        Exit Sub
    End If

    If Not m_CurrentForm Is Nothing Then
        If m_CurrentForm.Visible Then
            m_CurrentForm.LoadNote idx, isEnd
            m_CurrentForm.Show vbModeless
            Exit Sub
        End If
    End If

    Set m_CurrentForm = New frmComments
    m_CurrentForm.LoadNote idx, isEnd
    m_CurrentForm.Show vbModeless
End Sub

'-------------------------------------------------------------
' סעיף 2: זיהוי ההערה שהסמן נמצא בתוכה
'-------------------------------------------------------------
Public Function CurrentFootnoteIndex(ByRef idx As Long, ByRef isEnd As Boolean) As Boolean
    idx = 0
    isEnd = False

    Dim st As WdStoryType
    st = Selection.StoryType

    Dim selStart As Long
    selStart = Selection.Start

    If st = wdFootnotesStory Then
        Dim fn As Word.Footnote
        For Each fn In ThisDocument.Footnotes
            If selStart >= fn.Range.Start And selStart <= fn.Range.End Then
                idx = fn.Index
                isEnd = False
                CurrentFootnoteIndex = True
                Exit Function
            End If
        Next fn
    ElseIf st = wdEndnotesStory Then
        Dim en As Word.Endnote
        For Each en In ThisDocument.Endnotes
            If selStart >= en.Range.Start And selStart <= en.Range.End Then
                idx = en.Index
                isEnd = True
                CurrentFootnoteIndex = True
                Exit Function
            End If
        Next en
    End If
End Function

'-------------------------------------------------------------
' סעיף 3: איסוף השרשור (ראש + תגובות) לפי טווח ההפניה
'-------------------------------------------------------------
Public Function GetThreadForNote(ByVal idx As Long, ByVal isEnd As Boolean) As Collection
    Dim result As New Collection

    Dim refStart As Long, refEnd As Long
    If isEnd Then
        refStart = ThisDocument.Endnotes(idx).Reference.Start
        refEnd = ThisDocument.Endnotes(idx).Reference.End
    Else
        refStart = ThisDocument.Footnotes(idx).Reference.Start
        refEnd = ThisDocument.Footnotes(idx).Reference.End
    End If

    Dim c As Word.Comment
    For Each c In ThisDocument.Comments
        On Error Resume Next
        Dim scStart As Long, scEnd As Long
        scStart = c.Scope.Start
        scEnd = c.Scope.End
        On Error GoTo 0

        If scStart <= refEnd And scEnd >= refStart Then
            result.Add c
        End If
    Next c

    Set GetThreadForNote = result
End Function

'-------------------------------------------------------------
' סעיף 4: פעולות
'-------------------------------------------------------------

' הוספת הערה ראשית (רק אם אין עדיין ראש).
' צובע את המילים המסומנות בהערת השוליים במרקר צהוב.
' נשלחים: idx, isEnd (מיקום ההערה), והטקסט של ההערה + כותב.
' ה-Symbol Selection נלקח כאן מתוך הערת השוליים.
Public Function AddRootComment(ByVal idx As Long, ByVal isEnd As Boolean, _
                               ByVal text As String, _
                               Optional ByVal author As String = "") As Boolean
    AddRootComment = False

    ' אסור שני ראשים: בדוק שאין כבר Comment על הטווח
    Dim existing As Collection
    Set existing = GetThreadForNote(idx, isEnd)
    If existing.Count > 0 Then
        Exit Function
    End If

    ' צביעה צהובה של המילים המסומנות בהערת השוליים (אם יש סימון)
    On Error Resume Next
    If Selection.StoryType = wdFootnotesStory Or Selection.StoryType = wdEndnotesStory Then
        If Selection.Range.Start <> Selection.Range.End Then   ' יש סימון
            Selection.Range.HighlightColorIndex = wdYellow
        End If
    End If
    On Error GoTo 0

    ' יצירת ההערה על ההפניה
    On Error GoTo Fail
    Dim rng As Word.Range
    If isEnd Then
        Set rng = ThisDocument.Endnotes(idx).Reference.Duplicate
    Else
        Set rng = ThisDocument.Footnotes(idx).Reference.Duplicate
    End If

    Dim c As Word.Comment
    Set c = ThisDocument.Comments.Add(rng, text)
    If Len(author) > 0 Then c.author = author

    AddRootComment = True
    Exit Function
Fail:
    AddRootComment = False
End Function

' הוספת תגובה לראש הקיים (נוצר על אותו טווח)
Public Function AddReplyToNote(ByVal idx As Long, ByVal isEnd As Boolean, _
                               ByVal text As String, _
                               Optional ByVal author As String = "") As Boolean
    On Error GoTo Fail

    Dim th As Collection
    Set th = GetThreadForNote(idx, isEnd)
    If th.Count = 0 Then
        AddReplyToNote = False
        Exit Function
    End If

    Dim root As Word.Comment
    Set root = th(1)

    Dim rep As Word.Comment
    Set rep = root.Replies.Add(root.Scope, text)
    If Len(author) > 0 Then rep.author = author

    AddReplyToNote = True
    Exit Function
Fail:
    AddReplyToNote = False
End Function

' מחיקת שרשור שלם (ראש + כל תגובותיו)
Public Function DeleteThread(ByVal idx As Long, ByVal isEnd As Boolean) As Boolean
    On Error GoTo Fail

    Dim th As Collection
    Set th = GetThreadForNote(idx, isEnd)
    If th.Count = 0 Then
        DeleteThread = False
        Exit Function
    End If

    Dim i As Long
    For i = th.Count To 1 Step -1
        th(i).Delete
    Next i

    DeleteThread = True
    Exit Function
Fail:
    DeleteThread = False
End Function

[יעב"ץ]

@צבי-צ
אני לא הצלחתי לחלץ את זה, נפתח לי קובץ ריק כל פעם.
איך שומרים?
ומה זה שונה ממאקרו רגיל?

[צבי צ]

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

צריך שהוא יהיה באותה תיקייה עם הקובץ הערות-סקירה-מדומות.docm.

אחרי שהקובץ יסיים את הפעולה שלו המאקרו מותקן לך ולא צריך לעשות כלום.

[יעב"ץ]

יעב-ץ כתב:

ומה זה שונה ממאקרו רגיל?

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

@יעב-ץ
תבדוק את מה שכתבתי בשרשור של המאקרו, זה אמור להיות הכי פשוט
או שתגיד לי מה הפירוש לא הצלחת להתקין?

[יעב"ץ]

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

[יעב"ץ]

@שמעון-פרידנן
אגב, זה קובץ docm. או dotm.?
פעם אחת הבאת כזה ופעם אחת כזה.

[יעב"ץ]

@צבי-צ

@צבי-צ כתב:

אתה צודק, יש איך לפתור את זה

בינתיים, עד שההוא יסתדר, אולי תפתור את זה?

[צבי צ]

@יעב-ץ
חבל על העבודה כבר יש מסודר ומוכן.

[יעב"ץ]

@צבי-צ
אז מה הקוד לטעינה רגילה דרך הממשק הרגיל?

[צבי צ]

@יעב-ץ
תפעיל את הקובץ BAT ששלחתי ותראה ישועות.
מצרף שוב [אין צורך לשנות סיומת]
https://www.jumbomail.me/j/z_3C4pXjBk-u_gx

[יעב"ץ]

@צבי-צ
אני לא אוהב לעשות דברים שאני מרגיש שאין לי שליטה בתהליך.

למה זה שונה מכל מאקרו?

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

@צבי-צ
אתה הצלחת להפעיל את זה בפועל?

[צבי צ]

@שמעון-פרידנן
כן, אבל או בקובץ שהבאת [וא"א להעביר לקובץ קיים] או ע"י הקובץ BAT שהבאתי למעלה.
מה ששלחת עכשיו גם מביא שגיאה שהסמן צריך להיות בהערת שוליים, והוא כמובן שם.

Spoiler

וכתבתי וחוזר וכותב זה הרבה יותר טוב ממה שאני כתבתי (בנוסף לכך שזה רק בהערת שוליים ולא בהערת סיום).

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

@צבי-צ כתב:

מה ששלחת עכשיו גם מביא שגיאה שהסמן צריך להיות בהערת שוליים, והוא כמובן שם.

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

[צבי צ]

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

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

פוסט זה נמחק!

[צבי צ]

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