שיתוף | "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.

[pcinfogmach]

@menajemmendel כתב בשיתוף | "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.:

מה תעשו אם תצטרכו למיין דברים בתוך המאקרו [לקבוע משתנים וכדו'] עצמו לצורך המשך שימשו במאקרו, [ולא דוקא לפי סדר אלפאבתי, אלא לפי כל ערך אחר כגון לסדר תמונות לפי הגודל שלהם, או משהו כזה]? שם אין לכם את כלי המיון של וורד, ואתם חייבים אלגוריתם כמו Bubble Sort. [אגב לפני שבועים היה לי כזה מקרה, ואני לא ידעתי על קיומו של אלגוריטם בועה, וחשבתי על הרבה זמן, איך ניתן לסדר, ובאמת יצא לי משהו מאד דומה לאגוריטם בועה, ואתמול גיליתי את השיטה של בועה, ושאני לא הגאון הראשון.]

עיין כאן נראה שיש להם רעיון משופר
https://stackoverflow.com/a/38298771/23343154

שווה גם לחקור את CreateObject יייתכן שאפשר לייבא משהו עם פונקצונליות מובנית

Spoiler

וחשבתי על הרבה זמן, איך ניתן לסדר, ובאמת יצא לי משהו מאד דומה לאגוריטם בועה

עצה טובה לכל אלה שאוהבים לחשוב ולהמציא באמת שכדאי לכם לעשות חיפוש באינטרנט לפני שאתם ממציאים את הגלגל - וגם לפעמים לפני שאתם שואלים את GPT

[menajemmendel]

@pcinfogmach באמת יש הרבה רעיונות יותר טובים יש גם INSERTION SORT וגם QUICKSORT, ובועה היא השיטה הכי פחות יעילה מכולם, והכי איטית, אבל היא גם הכי פשוטה, אז תלוי למה צריך את זה. בכל אופן לא התכוונתי שזה הצורה האופטימלית, אלא שלמטרות למידה זה טוב.

[מניין]

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

Sub גודל_עמודים_ושוליים_בכל_המסמך()
    Dim sec As section
    Dim pageSetup As pageSetup
    Dim currentWidth As Double
    Dim currentHeight As Double
    Dim marginTop As Double
    Dim marginBottom As Double
    Dim marginLeft As Double
    Dim marginRight As Double
    Dim startPage As Long
    Dim endPage As Long
    Dim msg As String
    Dim totalPages As Long
    Dim currentSectionIndex As Long
    Dim lastWidth As Double
    Dim lastHeight As Double
    Dim lastTopMargin As Double
    Dim lastBottomMargin As Double
    Dim lastLeftMargin As Double
    Dim lastRightMargin As Double
    Dim allPagesUniform As Boolean
    Dim firstRun As Boolean

    ' הודעת כותרת
    msg = "מידע על גדלי העמודים והשוליים במסמך (בסנטימטרים):" & vbCrLf
    totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
    currentSectionIndex = 1
    startPage = 1
    firstRun = True
    allPagesUniform = True ' נניח בהתחלה שכולם אחידים

    ' לולאה לבדוק אם כל העמודים אחידים בגודל ובשוליים
    Do While startPage <= totalPages
        If currentSectionIndex > ActiveDocument.Sections.Count Then Exit Do
        Set sec = ActiveDocument.Sections(currentSectionIndex)
        Set pageSetup = sec.pageSetup
        currentWidth = pageSetup.PageWidth / 28.35 ' המרת רוחב לס"מ
        currentHeight = pageSetup.PageHeight / 28.35 ' המרת גובה לס"מ
        marginTop = pageSetup.TopMargin / 28.35 ' המרת שוליים עליונים לס"מ
        marginBottom = pageSetup.BottomMargin / 28.35 ' המרת שוליים תחתונים לס"מ
        marginLeft = pageSetup.LeftMargin / 28.35 ' המרת שוליים שמאליים לס"מ
        marginRight = pageSetup.RightMargin / 28.35 ' המרת שוליים ימניים לס"מ

        ' אם זו הפעם הראשונה, נגדיר את הערכים הראשונים
        If firstRun Then
            lastWidth = currentWidth
            lastHeight = currentHeight
            lastTopMargin = marginTop
            lastBottomMargin = marginBottom
            lastLeftMargin = marginLeft
            lastRightMargin = marginRight
            firstRun = False
        End If

        ' אם יש שינוי בגודל או בשוליים, העמודים לא אחידים
        If currentWidth <> lastWidth Or currentHeight <> lastHeight Or _
           marginTop <> lastTopMargin Or marginBottom <> lastBottomMargin Or _
           marginLeft <> lastLeftMargin Or marginRight <> lastRightMargin Then
            allPagesUniform = False
            Exit Do ' אין צורך לבדוק יותר אם העמודים לא אחידים
        End If

        ' מעבר לעמוד הבא
        startPage = startPage + 1
        If startPage > ActiveDocument.Sections(currentSectionIndex).Range.Information(wdActiveEndPageNumber) Then
            currentSectionIndex = currentSectionIndex + 1
            If currentSectionIndex > ActiveDocument.Sections.Count Then Exit Do
        End If
    Loop

    ' אם כל העמודים אחידים, הצגת הודעה אחת
    If allPagesUniform Then
        MsgBox "כל העמודים במסמך הם בגודל ושוליים זהים.", vbInformation, "מידע על גדלי עמודים ושוליים"
    Else
        ' אם יש עמודים שונים, מציגים את כל הנתונים
        DisplayPageDetails
    End If
End Sub

Sub DisplayPageDetails()
    Dim sec As section
    Dim pageSetup As pageSetup
    Dim currentWidth As Double
    Dim currentHeight As Double
    Dim marginTop As Double
    Dim marginBottom As Double
    Dim marginLeft As Double
    Dim marginRight As Double
    Dim startPage As Long
    Dim endPage As Long
    Dim msg As String
    Dim totalPages As Long
    Dim currentSectionIndex As Long

    ' הודעת כותרת
    msg = "מידע על גדלי העמודים והשוליים במסמך (בסנטימטרים):" & vbCrLf
    totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
    currentSectionIndex = 1
    startPage = 1

    ' לולאה לבדיקת כל העמודים
    Do While startPage <= totalPages
        ' קבלת הגדרות הסעיף הנוכחי
        If currentSectionIndex > ActiveDocument.Sections.Count Then Exit Do
        Set sec = ActiveDocument.Sections(currentSectionIndex)
        Set pageSetup = sec.pageSetup
        currentWidth = pageSetup.PageWidth / 28.35 ' המרת רוחב לס"מ
        currentHeight = pageSetup.PageHeight / 28.35 ' המרת גובה לס"מ
        marginTop = pageSetup.TopMargin / 28.35 ' המרת שוליים עליונים לס"מ
        marginBottom = pageSetup.BottomMargin / 28.35 ' המרת שוליים תחתונים לס"מ
        marginLeft = pageSetup.LeftMargin / 28.35 ' המרת שוליים שמאליים לס"מ
        marginRight = pageSetup.RightMargin / 28.35 ' המרת שוליים ימניים לס"מ

        ' מציאת טווח עמודים עם אותו גודל ושוליים
        endPage = startPage
        Do While endPage <= totalPages
            If ActiveDocument.Sections(currentSectionIndex).pageSetup.PageWidth <> pageSetup.PageWidth Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.PageHeight <> pageSetup.PageHeight Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.TopMargin <> pageSetup.TopMargin Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.BottomMargin <> pageSetup.BottomMargin Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.LeftMargin <> pageSetup.LeftMargin Or _
               ActiveDocument.Sections(currentSectionIndex).pageSetup.RightMargin <> pageSetup.RightMargin Then
                Exit Do
            End If
            endPage = endPage + 1
            If endPage > ActiveDocument.Sections(currentSectionIndex).Range.Information(wdActiveEndPageNumber) Then
                currentSectionIndex = currentSectionIndex + 1
                If currentSectionIndex > ActiveDocument.Sections.Count Then Exit Do
            End If
        Loop
        endPage = endPage - 1

        ' הוספת טווח עמודים עם גודל ושוליים להודעה
        If startPage <= endPage Then
            msg = msg & "עמודים " & startPage & " עד " & endPage & ":" & vbCrLf
            msg = msg & "  גודל העמוד: " & vbCrLf
            msg = msg & Format(currentWidth, "0.00") & " x " & Format(currentHeight, "0.00") & " ס''מ" & vbCrLf
            msg = msg & "  שוליים:" & vbCrLf
            msg = msg & "    עליון: " & Format(marginTop, "0.00") & " ס''מ" & vbCrLf
            msg = msg & "    תחתון: " & Format(marginBottom, "0.00") & " ס''מ" & vbCrLf
            msg = msg & "    שמאלי: " & Format(marginLeft, "0.00") & " ס''מ" & vbCrLf
            msg = msg & "    ימני: " & Format(marginRight, "0.00") & " ס''מ" & vbCrLf
        End If

        ' מעבר לטווח הבא
        startPage = endPage + 1
    Loop

    ' הצגת ההודעה בעברית
    MsgBox msg, vbInformation, "מידע על גדלי עמודים ושוליים"
End Sub