הסבר | מאקרו מעניין לחיפוש סגנון כותרת בסוף עמוד

[מניין]

תגובה: [בעיה | שאלה בוורד](פתרון ל''מנע הפרדת פיסקאות'' במקום שיש מעבר מקטע רציף)
המשך לבעיה שהוזכר כאן על ידי @menajemmendel, והפיתרון החלקי שהביאו כאן, אבל הבעיה היא בפרט בקבצים של מאות עמודים שלא יודעים אם יש את הבעיה ובאיזה מקום, ועל זה יכול לעזור המאקרו דלהלן שפשוט מחפש אם יש כותרת בסוף עמוד ועוצר שם כדי לדעת לתקן את זה, אם רוצים אפשר להוסיף למאקרו גם אפשרות של תיקון אוטומטי, אבל זה לא כדאי, עדיף לתקן באופן פרטני בכל מקום שצריך.
הנה המקרו [עריכה: מתוקן]

Sub כותרת_בסוף_עמוד()
    ' הגדרת משתנים לזיהוי פסקאות, תוכן, ומיקומי סמן
    Dim currentPara As Paragraph
    Dim hasSectionBreak As Boolean
    Dim cleanText As String
    Dim startPosition As Long
    Dim nextPagePosition As Long
    
    ' הקפאת תצוגת המסך להאצת פעולת המאקרו
    Application.ScreenUpdating = False
    
    ' הגדרת מנגנון הקפיצה של וורד שיגיב לעמודים (ולא לשורות או הערות)
    Application.Browser.Target = wdBrowsePage
    
    ' הזזת הסמן פסקה אחת למטה כדי לא להיתקע על כותרת שכבר נמצאה בלחיצה הקודמת
    Selection.MoveDown Unit:=wdParagraph, Count:=2
    
    ' תחילת לולאה שרצה קדימה עמוד אחרי עמוד
    Do
        ' שמירת מיקום הסמן הנוכחי כדי לבדוק בהמשך אם הגענו לסוף המסמך
        startPosition = Selection.Start
        
        ' פקודה פיזית המקפיצה את הסמן לתחילת העמוד הבא
        Application.Browser.Next
        
        ' תנאי עצירה: אם המיקום לא השתנה לאחר הקפיצה, סימן שהגענו לסוף המסמך והלולאה מסתיימת
        If Selection.Start = startPosition Then Exit Do
        
        ' שמירת מיקום תחילת העמוד החדש כדי לחזור אליו במדויק בסוף הבדיקה
        nextPagePosition = Selection.Start
        
        ' חזרה תו אחד אחורה כדי להגיע בדיוק לתו הסוגר של העמוד הקודם
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        
        ' הגדרת הפסקה עליה עומד הסמן כפסקה הנוכחית לבדיקה
        Set currentPara = Selection.Paragraphs(1)
        
        ' בדיקה אם הפסקה מכילה תו מעבר מקטע (Chr12) או הגדרת מעבר עמוד לפניה
        hasSectionBreak = (InStr(currentPara.Range.Text, Chr(12)) > 0 Or currentPara.Range.ParagraphFormat.PageBreakBefore)
        
        ' אם נמצא מעבר מקטע, מתחילה בדיקת התוכן שלפניו
        If hasSectionBreak Then
            
            ' ניקוי רווחים, אנטרים ותווי מקטע מהפסקה כדי לבדוק אם יש בה טקסט אמיתי
            cleanText = Trim(Replace(Replace(Replace(currentPara.Range.Text, vbCr, ""), vbLf, ""), Chr(12), ""))
            
            ' לולאה שעולה פסקאות למעלה כל עוד היא פוגשת שורות ריקות או מעברי מקטע נסתרים
            Do While Len(cleanText) = 0
                Selection.MoveUp Unit:=wdParagraph, Count:=1
                Set currentPara = Selection.Paragraphs(1)
                cleanText = Trim(Replace(Replace(Replace(currentPara.Range.Text, vbCr, ""), vbLf, ""), Chr(12), ""))
                
                ' הגנה: עצירת הלולאה למקרה הקיצוני שהגענו לתחילת המסמך (מיקום 0)
                If Selection.Start = 0 Then Exit Do
            Loop
            
            ' בדיקה אם הפסקה עם הטקסט שמצאנו מוגדרת ככותרת (רמות מתאר 1 עד 9)
            If currentPara.OutlineLevel >= 1 And currentPara.OutlineLevel <= 9 Then
                
                ' החזרת עדכון התצוגה כדי שהמשתמש יראה את הסימון במסמך
                Application.ScreenUpdating = True
                
                ' בחירה (סימון) של הכותרת המנותקת שנמצאה
                currentPara.Range.Select
                
                ' השמעת צליל התראה
                Beep
                
                ' יציאה מהמאקרו ועצירה לתיקון המשתמש
                Exit Sub
            End If
            
        End If
        
        ' החזרת הסמן (טלפורט) לתחילת העמוד הבא ששמרנו מראש, למניעת לולאה אינסופית
        Selection.Start = nextPagePosition
        Selection.End = nextPagePosition
        
    Loop
    
    ' החזרת עדכון התצוגה למצב רגיל בסיום המסמך
    Application.ScreenUpdating = True
    
    ' הצגת הודעה שהסריקה הושלמה בהצלחה
    MsgBox "הסריקה הסתיימה. לא נמצאו כותרות מנותקות נוספות בסופי עמודים.", vbInformation, "סוף מסמך"
End Sub

[שלמה11]

@מניין כתב בהסבר | מאקרו מעניין לחיפוש סגנון כותרת בסוף עמוד:

יש בעיה אחת שבכל לחיצה הוא בודק את כל המסמך, ובמסמך גדול זה מאט מאוד, מי שיודע איך לשפר אותו אשמח מאוד

אני חושב שהבעיה בשורה הזאת:

Static pageNum As Long

תכתוב במקום זה:

Dim pageNum As Long

ותעלה את השורה הזאת בתחילת הקוד עוד לפני התחלת הקוד עצמו (שזה יהיה שורה מס' 1)
שים לב שזה לא מתאפס עד הפעם הבאה שיפעילו את וורד אפשר להוסיף קוד:

Sub איפוס_מספר_עמוד
    pageNum = 0
End Sub

[מניין]

@שלמה11 מצאתי את הפיתרון בלי ספירת העמודים בכלל, החלפתי למעלה את החדש המעודכן.