דילוג לתוכן
  • חוקי הפורום
  • פופולרי
  • לא נפתר
  • משתמשים
  • חיפוש גוגל בפורום
  • צור קשר
עיצובים
  • Light
  • Cerulean
  • Cosmo
  • Flatly
  • Journal
  • Litera
  • Lumen
  • Lux
  • Materia
  • Minty
  • Morph
  • Pulse
  • Sandstone
  • Simplex
  • Sketchy
  • Spacelab
  • United
  • Yeti
  • Zephyr
  • Dark
  • Cyborg
  • Darkly
  • Quartz
  • Slate
  • Solar
  • Superhero
  • Vapor

  • ברירת מחדל (ללא עיצוב (ברירת מחדל))
  • ללא עיצוב (ברירת מחדל)
כיווץ
מתמחים טופ
  1. דף הבית
  2. תוכנות
  3. יישומי אופיס
  4. וורד
  5. עזרה הדדית - וורד
  6. שיתוף | "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.

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

מתוזמן נעוץ נעול הועבר עזרה הדדית - וורד
300 פוסטים 31 כותבים 24.7k צפיות 32 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • מ מניין

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

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

    @menajemmendel למה זה?

    זה תגובה לבקשת @מניין כאן (שביקש אם מישהו יכול לכתוב קוד שיעבוד גם בשתי טורים).

    כנראה לא הסברתי את עצמי טוב, אני רציתי שיהיה כמו בתמונה המצורפת, והמאקרו שלך לא פתר את זה, אבל למעשה זה לא נצרך כי מספיק שיש סימון בתחילת העמוד ובסוף העמוד, ולכן מחקתי את הבקשה.
    רק עדיין מעניין אותי אם יש אפשרות כזאת של מאקרו שימצא את סוף הטור של צד ימין ואת תחילת הטור של צד שמאל, ניסיתי בgpt בכמה וכמה שיטות והוא לא הצליח בשום אופן.
    4d73c7c8-dd91-4032-9cc3-60ca7877a73b-image.png

    menajemmendelM מנותק
    menajemmendelM מנותק
    menajemmendel
    כתב נערך לאחרונה על ידי menajemmendel
    #191

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

    תגובה 1 תגובה אחרונה
    2
    • מ מניין

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

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

      @menajemmendel למה זה?

      זה תגובה לבקשת @מניין כאן (שביקש אם מישהו יכול לכתוב קוד שיעבוד גם בשתי טורים).

      כנראה לא הסברתי את עצמי טוב, אני רציתי שיהיה כמו בתמונה המצורפת, והמאקרו שלך לא פתר את זה, אבל למעשה זה לא נצרך כי מספיק שיש סימון בתחילת העמוד ובסוף העמוד, ולכן מחקתי את הבקשה.
      רק עדיין מעניין אותי אם יש אפשרות כזאת של מאקרו שימצא את סוף הטור של צד ימין ואת תחילת הטור של צד שמאל, ניסיתי בgpt בכמה וכמה שיטות והוא לא הצליח בשום אופן.
      4d73c7c8-dd91-4032-9cc3-60ca7877a73b-image.png

      P מנותק
      P מנותק
      pcinfogmach
      מדריכים
      כתב נערך לאחרונה על ידי
      #192

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

      ניסיתי בgpt בכמה וכמה שיטות והוא לא הצליח בשום אופן.

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

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

      menajemmendelM תגובה 1 תגובה אחרונה
      1
      • P pcinfogmach

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

        ניסיתי בgpt בכמה וכמה שיטות והוא לא הצליח בשום אופן.

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

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

        menajemmendelM מנותק
        menajemmendelM מנותק
        menajemmendel
        כתב נערך לאחרונה על ידי menajemmendel
        #193

        @pcinfogmach אני אישית משתמש בשיטה אחרת (לדעתי יותר טובה, לולאה, שבודקת אם הטקטס בשורה הזו נמוך מבחינת גובה יותר מהטקסט בשורה הקודמת)

        menajemmendelM תגובה 1 תגובה אחרונה
        1
        • menajemmendelM menajemmendel

          @pcinfogmach אני אישית משתמש בשיטה אחרת (לדעתי יותר טובה, לולאה, שבודקת אם הטקטס בשורה הזו נמוך מבחינת גובה יותר מהטקסט בשורה הקודמת)

          menajemmendelM מנותק
          menajemmendelM מנותק
          menajemmendel
          כתב נערך לאחרונה על ידי menajemmendel
          #194

          🌀 המאקרו שישים סוף לעוגמת הנפש – סידור מילים בסדר עולה! 🌀

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

          הבעיה הידועה:

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

          כמה פעמים אמרתם לעצמכם:

          • "למה המילים האלה לא מסודרות בצורה נורמלית?"
          • "איך אני אמור לקרוא את זה?"
          • "איזו עוגמת נפש!"
          • מישהו שולח לכם חידוש תורה, ואתם שואלים את עצמכם: "למה 'מצווה' מגיעה לפני 'ברכה'? זה לא הגיוני!"

          🔄 הפתרון – המאקרו החדש שלי!

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

          📌 איך זה עובד?
          זה פשוט גאוני – המאקרו משתמש באלגוריתם ה"בועה" (Bubble Sort), הידוע כאלגוריתם שמביא סדר לעולם, ומסדר את המילים שלכם כמו שחלמתם.
          דוגמאות לשימושים מעשיים:
          • סידור כתבות מבולגנות מהעיתון.
          • מיון חידושי תורה כך שגם החברותא שלכם יבין מה קורה.
          • סידור מכתבים מחברים כדי שתוכלו סוף סוף להבין מה הם רוצים להגיד.

          📣 תגובות נרגשות מהשטח:

          💬 "סידור המילים שינה לי את החיים. סוף סוף אני יכול לקרוא בלי להתרגז."
          💬 "חשבתי שבלגן בטקסטים זה גזירת גורל, אבל המאקרו הזה פתח לי את העיניים."
          💬 "Bubble Sort? יותר כמו Life Sort! החיים שלי מסודרים עכשיו."
          💬 "זה לא רק כלי, זה פילוסופיית חיים. כל המילים במקום אחד – מדהים."
          💬 "מאז שסידרתי את רשימת המכולת שלי, הכל מרגיש טוב יותר."

          💔 למי שאין את המאקרו הזה:

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

          🛠️ אז למה אתם מחכים?

          הגיע הזמן לשים סוף לבלגן! תתקינו את הקוד, סדרו את המילים שלכם, ותצאו לחופשי!
          אגב אני רוצה להדגיש שכמה שהמאקרוים שלי נראים יפים להפליא הם פרי יצירתי ולא ממו''ר GPT, פשוט לאחרונה רכשתי קורס של VBA לוורד (ושיפר את ביצועים שלי בעשרות מונים)

          Sub ARRAYSAMPLE2()
          Dim otext As String
          Dim wordList() As String
          Dim temporal As String
          Dim newdoc As Document
          Dim confirmation As VbMsgBoxResult
          
              
              confirmation = MsgBox("אל תשתמשו בסמך גדול, כי יקח לזה הרבה זמן, רצונך למהשיך", _
                              vbYesNo + vbQuestion)
          
          If confirmation = vbYes Then
              
              otext = ActiveDocument.Content
              wordList = Split(otext, " ")
              
              
              'sort with Bubble Sort method
                  For i = LBound(wordList) To (UBound(wordList) - 1)
                      For j = i + 1 To UBound(wordList)
                          If wordList(i) > wordList(j) Then
                              temporal = wordList(i)
                              wordList(i) = wordList(j)
                              wordList(j) = temporal
                          End If
                          DoEvents
                      Next j
                  Next i
              
              
              Set newdoc = Documents.Add
              newdoc.Content.InsertAfter Join(wordList, ", ")
          
          End If
          End Sub
          
          צ ד 2 תגובות תגובה אחרונה
          0
          • menajemmendelM menajemmendel

            🌀 המאקרו שישים סוף לעוגמת הנפש – סידור מילים בסדר עולה! 🌀

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

            הבעיה הידועה:

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

            כמה פעמים אמרתם לעצמכם:

            • "למה המילים האלה לא מסודרות בצורה נורמלית?"
            • "איך אני אמור לקרוא את זה?"
            • "איזו עוגמת נפש!"
            • מישהו שולח לכם חידוש תורה, ואתם שואלים את עצמכם: "למה 'מצווה' מגיעה לפני 'ברכה'? זה לא הגיוני!"

            🔄 הפתרון – המאקרו החדש שלי!

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

            📌 איך זה עובד?
            זה פשוט גאוני – המאקרו משתמש באלגוריתם ה"בועה" (Bubble Sort), הידוע כאלגוריתם שמביא סדר לעולם, ומסדר את המילים שלכם כמו שחלמתם.
            דוגמאות לשימושים מעשיים:
            • סידור כתבות מבולגנות מהעיתון.
            • מיון חידושי תורה כך שגם החברותא שלכם יבין מה קורה.
            • סידור מכתבים מחברים כדי שתוכלו סוף סוף להבין מה הם רוצים להגיד.

            📣 תגובות נרגשות מהשטח:

            💬 "סידור המילים שינה לי את החיים. סוף סוף אני יכול לקרוא בלי להתרגז."
            💬 "חשבתי שבלגן בטקסטים זה גזירת גורל, אבל המאקרו הזה פתח לי את העיניים."
            💬 "Bubble Sort? יותר כמו Life Sort! החיים שלי מסודרים עכשיו."
            💬 "זה לא רק כלי, זה פילוסופיית חיים. כל המילים במקום אחד – מדהים."
            💬 "מאז שסידרתי את רשימת המכולת שלי, הכל מרגיש טוב יותר."

            💔 למי שאין את המאקרו הזה:

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

            🛠️ אז למה אתם מחכים?

            הגיע הזמן לשים סוף לבלגן! תתקינו את הקוד, סדרו את המילים שלכם, ותצאו לחופשי!
            אגב אני רוצה להדגיש שכמה שהמאקרוים שלי נראים יפים להפליא הם פרי יצירתי ולא ממו''ר GPT, פשוט לאחרונה רכשתי קורס של VBA לוורד (ושיפר את ביצועים שלי בעשרות מונים)

            Sub ARRAYSAMPLE2()
            Dim otext As String
            Dim wordList() As String
            Dim temporal As String
            Dim newdoc As Document
            Dim confirmation As VbMsgBoxResult
            
                
                confirmation = MsgBox("אל תשתמשו בסמך גדול, כי יקח לזה הרבה זמן, רצונך למהשיך", _
                                vbYesNo + vbQuestion)
            
            If confirmation = vbYes Then
                
                otext = ActiveDocument.Content
                wordList = Split(otext, " ")
                
                
                'sort with Bubble Sort method
                    For i = LBound(wordList) To (UBound(wordList) - 1)
                        For j = i + 1 To UBound(wordList)
                            If wordList(i) > wordList(j) Then
                                temporal = wordList(i)
                                wordList(i) = wordList(j)
                                wordList(j) = temporal
                            End If
                            DoEvents
                        Next j
                    Next i
                
                
                Set newdoc = Documents.Add
                newdoc.Content.InsertAfter Join(wordList, ", ")
            
            End If
            End Sub
            
            צ מנותק
            צ מנותק
            צדיק וטוב לו 0
            כתב נערך לאחרונה על ידי
            #195

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

            ח תגובה 1 תגובה אחרונה
            4
            • צ צדיק וטוב לו 0

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

              ח מנותק
              ח מנותק
              חוות דעת
              כתב נערך לאחרונה על ידי
              #196

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

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

              גם אני לא הבנתי כלום.
              לא יודע מה הבעיה, ועל מה הפתרון.

              תגובה 1 תגובה אחרונה
              1
              • menajemmendelM menajemmendel

                🌀 המאקרו שישים סוף לעוגמת הנפש – סידור מילים בסדר עולה! 🌀

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

                הבעיה הידועה:

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

                כמה פעמים אמרתם לעצמכם:

                • "למה המילים האלה לא מסודרות בצורה נורמלית?"
                • "איך אני אמור לקרוא את זה?"
                • "איזו עוגמת נפש!"
                • מישהו שולח לכם חידוש תורה, ואתם שואלים את עצמכם: "למה 'מצווה' מגיעה לפני 'ברכה'? זה לא הגיוני!"

                🔄 הפתרון – המאקרו החדש שלי!

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

                📌 איך זה עובד?
                זה פשוט גאוני – המאקרו משתמש באלגוריתם ה"בועה" (Bubble Sort), הידוע כאלגוריתם שמביא סדר לעולם, ומסדר את המילים שלכם כמו שחלמתם.
                דוגמאות לשימושים מעשיים:
                • סידור כתבות מבולגנות מהעיתון.
                • מיון חידושי תורה כך שגם החברותא שלכם יבין מה קורה.
                • סידור מכתבים מחברים כדי שתוכלו סוף סוף להבין מה הם רוצים להגיד.

                📣 תגובות נרגשות מהשטח:

                💬 "סידור המילים שינה לי את החיים. סוף סוף אני יכול לקרוא בלי להתרגז."
                💬 "חשבתי שבלגן בטקסטים זה גזירת גורל, אבל המאקרו הזה פתח לי את העיניים."
                💬 "Bubble Sort? יותר כמו Life Sort! החיים שלי מסודרים עכשיו."
                💬 "זה לא רק כלי, זה פילוסופיית חיים. כל המילים במקום אחד – מדהים."
                💬 "מאז שסידרתי את רשימת המכולת שלי, הכל מרגיש טוב יותר."

                💔 למי שאין את המאקרו הזה:

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

                🛠️ אז למה אתם מחכים?

                הגיע הזמן לשים סוף לבלגן! תתקינו את הקוד, סדרו את המילים שלכם, ותצאו לחופשי!
                אגב אני רוצה להדגיש שכמה שהמאקרוים שלי נראים יפים להפליא הם פרי יצירתי ולא ממו''ר GPT, פשוט לאחרונה רכשתי קורס של VBA לוורד (ושיפר את ביצועים שלי בעשרות מונים)

                Sub ARRAYSAMPLE2()
                Dim otext As String
                Dim wordList() As String
                Dim temporal As String
                Dim newdoc As Document
                Dim confirmation As VbMsgBoxResult
                
                    
                    confirmation = MsgBox("אל תשתמשו בסמך גדול, כי יקח לזה הרבה זמן, רצונך למהשיך", _
                                    vbYesNo + vbQuestion)
                
                If confirmation = vbYes Then
                    
                    otext = ActiveDocument.Content
                    wordList = Split(otext, " ")
                    
                    
                    'sort with Bubble Sort method
                        For i = LBound(wordList) To (UBound(wordList) - 1)
                            For j = i + 1 To UBound(wordList)
                                If wordList(i) > wordList(j) Then
                                    temporal = wordList(i)
                                    wordList(i) = wordList(j)
                                    wordList(j) = temporal
                                End If
                                DoEvents
                            Next j
                        Next i
                    
                    
                    Set newdoc = Documents.Add
                    newdoc.Content.InsertAfter Join(wordList, ", ")
                
                End If
                End Sub
                
                ד מנותק
                ד מנותק
                דאנציג
                כתב נערך לאחרונה על ידי
                #197

                @menajemmendel

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

                זה נראה שביקשת מGPT לכתוב את הפוסט,

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

                @menajemmendel תכתוב למודל שאתה משתמש בו שייצר לך את הטקסטים, שהוא משעשע במקום להיות רציני.
                מההיכרות שלי איתך, אלמלא השורה הזו:

                אגב אני רוצה להדגיש שכמה שהמאקרוים שלי נראים יפים להפליא הם פרי יצירתי ולא ממו''ר GPT, פשוט לאחרונה רכשתי קורס של VBA לוורד (ושיפר את ביצועים שלי בעשרות מונים)

                הייתי כותב לך שלא מתאים לך להעלות דברים של GPT...

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

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

                ששמעוןש תגובה 1 תגובה אחרונה
                1
                • ד דאנציג

                  @menajemmendel

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

                  זה נראה שביקשת מGPT לכתוב את הפוסט,

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

                  @menajemmendel תכתוב למודל שאתה משתמש בו שייצר לך את הטקסטים, שהוא משעשע במקום להיות רציני.
                  מההיכרות שלי איתך, אלמלא השורה הזו:

                  אגב אני רוצה להדגיש שכמה שהמאקרוים שלי נראים יפים להפליא הם פרי יצירתי ולא ממו''ר GPT, פשוט לאחרונה רכשתי קורס של VBA לוורד (ושיפר את ביצועים שלי בעשרות מונים)

                  הייתי כותב לך שלא מתאים לך להעלות דברים של GPT...

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

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

                  ששמעוןש מנותק
                  ששמעוןש מנותק
                  ששמעון
                  כתב נערך לאחרונה על ידי ששמעון
                  #198

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

                  menajemmendelM תגובה 1 תגובה אחרונה
                  2
                  • ששמעוןש ששמעון

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

                    menajemmendelM מנותק
                    menajemmendelM מנותק
                    menajemmendel
                    כתב נערך לאחרונה על ידי menajemmendel
                    #199

                    @ששמעון @דאנציג
                    או חבר'ה, תקשיבו,
                    אני באמת לא יודע מה עובר עליכם בזמן האחרון שאתם כ''כ קשוחים... אולי זה קשור למח' בין השו"ע והרש"ל אם ימי חנוכה נקבעו רק להלל והודאה או גם לשמחה (ואכמ''ל). אבל ברשותכם, אני רוצה לעשות סדר ולהבהיר:
                    בואו נגיד את האמת – שני המאקרואים שהעליתי פה הם לא שימושיים בכלל.
                    אני יודע את זה, ואתם יודעים את זה (לפחות עכשיו). אבל רגע, לפני שאתם זורקים את הקוד לפח ואותי ביחד עם הקוד, אבהיר שיש כאן הרבה מה ללמוד משתי הקודים האלו: המאקרו הראשון – ספירת אותיות:
                    הרעיון פה הוא לא אם זה באמת נחוץ לספור כמה פעמים האות "ק" מופיעה בטקסט.
                    הרעיון הוא ללמוד איך לעבוד עם Arrays – איך יוצרים רשימה, איך משתמשים בה, איך יודעים מה ההתחלה ומה הסוף (LBound ו-UBound). כמו שאכן ידידנו @u88 למד את זה והבין את הנושא בצורה ברורה!
                    מאקרו השני – סידור לפי א"ב:
                    כן, @ששמעון צודק שאפשר היה לעשות את זה בקלות עם מיון בסיסי: להחליף רווחים באנטרים, למיין ואז להחזיר. והאמת שהשיטה שהוא מציע עדיפה כשמדובר במסמכים גדולים, כי היא הרבה יותר מהירה (המאקרו שלי יקח לו הרבה זמן), אבל התועלת גדולה של המאקרו שלי הוא: כך:
                    מה תעשו אם תצטרכו למיין דברים בתוך המאקרו [לקבוע משתנים וכדו'] עצמו לצורך המשך שימשו במאקרו, [ולא דוקא לפי סדר אלפאבתי, אלא לפי כל ערך אחר כגון לסדר תמונות לפי הגודל שלהם, או משהו כזה]? שם אין לכם את כלי המיון של וורד, ואתם חייבים אלגוריתם כמו Bubble Sort. [אגב לפני שבועים היה לי כזה מקרה, ואני לא ידעתי על קיומו של אלגוריטם בועה, וחשבתי על הרבה זמן, איך ניתן לסדר, ובאמת יצא לי משהו מאד דומה לאגוריטם בועה, ואתמול גיליתי את השיטה של בועה, ושאני לא הגאון הראשון.]
                    בקיצור:
                    אני לא באמת חושב שהמאקרואים האלה יגרמו לכם לפרוץ בקריאות התפעלות, אבל הם כן תרגיל טוב למי שרוצה ללמוד VBA, ועשיתי את זה עם קצר הומור,
                    ואם זה לא מעניין אתכם – אז פשוט תעברו הלאה.

                    ו @דאנציג לגבי מה שכתבת

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

                    הייתי כותב לך שלא מתאים לך להעלות דברים של GPT...

                    לא הבנתי כוונתך באמת הקודים לא GPT כתב אותם, והקישור שהבאתי לכם על קורס VBA הוא אמיתי, באמת קורס מוצלח למי שזה מעניין אותו (אבל הוא באנגלית, ולא מסביר ממש למתחילים) יש להדגיש שזה הקורס היחיד שמצאתי על VBA לוורד, כולם מלמדים על אקסל ומתרגמים לוורד (אף אני כשהתחלתי עם VBA עשיתי כך בלית ברירה)

                    P 2 תגובות תגובה אחרונה
                    2
                    • menajemmendelM menajemmendel

                      @ששמעון @דאנציג
                      או חבר'ה, תקשיבו,
                      אני באמת לא יודע מה עובר עליכם בזמן האחרון שאתם כ''כ קשוחים... אולי זה קשור למח' בין השו"ע והרש"ל אם ימי חנוכה נקבעו רק להלל והודאה או גם לשמחה (ואכמ''ל). אבל ברשותכם, אני רוצה לעשות סדר ולהבהיר:
                      בואו נגיד את האמת – שני המאקרואים שהעליתי פה הם לא שימושיים בכלל.
                      אני יודע את זה, ואתם יודעים את זה (לפחות עכשיו). אבל רגע, לפני שאתם זורקים את הקוד לפח ואותי ביחד עם הקוד, אבהיר שיש כאן הרבה מה ללמוד משתי הקודים האלו: המאקרו הראשון – ספירת אותיות:
                      הרעיון פה הוא לא אם זה באמת נחוץ לספור כמה פעמים האות "ק" מופיעה בטקסט.
                      הרעיון הוא ללמוד איך לעבוד עם Arrays – איך יוצרים רשימה, איך משתמשים בה, איך יודעים מה ההתחלה ומה הסוף (LBound ו-UBound). כמו שאכן ידידנו @u88 למד את זה והבין את הנושא בצורה ברורה!
                      מאקרו השני – סידור לפי א"ב:
                      כן, @ששמעון צודק שאפשר היה לעשות את זה בקלות עם מיון בסיסי: להחליף רווחים באנטרים, למיין ואז להחזיר. והאמת שהשיטה שהוא מציע עדיפה כשמדובר במסמכים גדולים, כי היא הרבה יותר מהירה (המאקרו שלי יקח לו הרבה זמן), אבל התועלת גדולה של המאקרו שלי הוא: כך:
                      מה תעשו אם תצטרכו למיין דברים בתוך המאקרו [לקבוע משתנים וכדו'] עצמו לצורך המשך שימשו במאקרו, [ולא דוקא לפי סדר אלפאבתי, אלא לפי כל ערך אחר כגון לסדר תמונות לפי הגודל שלהם, או משהו כזה]? שם אין לכם את כלי המיון של וורד, ואתם חייבים אלגוריתם כמו Bubble Sort. [אגב לפני שבועים היה לי כזה מקרה, ואני לא ידעתי על קיומו של אלגוריטם בועה, וחשבתי על הרבה זמן, איך ניתן לסדר, ובאמת יצא לי משהו מאד דומה לאגוריטם בועה, ואתמול גיליתי את השיטה של בועה, ושאני לא הגאון הראשון.]
                      בקיצור:
                      אני לא באמת חושב שהמאקרואים האלה יגרמו לכם לפרוץ בקריאות התפעלות, אבל הם כן תרגיל טוב למי שרוצה ללמוד VBA, ועשיתי את זה עם קצר הומור,
                      ואם זה לא מעניין אתכם – אז פשוט תעברו הלאה.

                      ו @דאנציג לגבי מה שכתבת

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

                      הייתי כותב לך שלא מתאים לך להעלות דברים של GPT...

                      לא הבנתי כוונתך באמת הקודים לא GPT כתב אותם, והקישור שהבאתי לכם על קורס VBA הוא אמיתי, באמת קורס מוצלח למי שזה מעניין אותו (אבל הוא באנגלית, ולא מסביר ממש למתחילים) יש להדגיש שזה הקורס היחיד שמצאתי על VBA לוורד, כולם מלמדים על אקסל ומתרגמים לוורד (אף אני כשהתחלתי עם VBA עשיתי כך בלית ברירה)

                      P מנותק
                      P מנותק
                      pcinfogmach
                      מדריכים
                      כתב נערך לאחרונה על ידי
                      #200
                      פוסט זה נמחק!
                      תגובה 1 תגובה אחרונה
                      0
                      • menajemmendelM menajemmendel

                        @ששמעון @דאנציג
                        או חבר'ה, תקשיבו,
                        אני באמת לא יודע מה עובר עליכם בזמן האחרון שאתם כ''כ קשוחים... אולי זה קשור למח' בין השו"ע והרש"ל אם ימי חנוכה נקבעו רק להלל והודאה או גם לשמחה (ואכמ''ל). אבל ברשותכם, אני רוצה לעשות סדר ולהבהיר:
                        בואו נגיד את האמת – שני המאקרואים שהעליתי פה הם לא שימושיים בכלל.
                        אני יודע את זה, ואתם יודעים את זה (לפחות עכשיו). אבל רגע, לפני שאתם זורקים את הקוד לפח ואותי ביחד עם הקוד, אבהיר שיש כאן הרבה מה ללמוד משתי הקודים האלו: המאקרו הראשון – ספירת אותיות:
                        הרעיון פה הוא לא אם זה באמת נחוץ לספור כמה פעמים האות "ק" מופיעה בטקסט.
                        הרעיון הוא ללמוד איך לעבוד עם Arrays – איך יוצרים רשימה, איך משתמשים בה, איך יודעים מה ההתחלה ומה הסוף (LBound ו-UBound). כמו שאכן ידידנו @u88 למד את זה והבין את הנושא בצורה ברורה!
                        מאקרו השני – סידור לפי א"ב:
                        כן, @ששמעון צודק שאפשר היה לעשות את זה בקלות עם מיון בסיסי: להחליף רווחים באנטרים, למיין ואז להחזיר. והאמת שהשיטה שהוא מציע עדיפה כשמדובר במסמכים גדולים, כי היא הרבה יותר מהירה (המאקרו שלי יקח לו הרבה זמן), אבל התועלת גדולה של המאקרו שלי הוא: כך:
                        מה תעשו אם תצטרכו למיין דברים בתוך המאקרו [לקבוע משתנים וכדו'] עצמו לצורך המשך שימשו במאקרו, [ולא דוקא לפי סדר אלפאבתי, אלא לפי כל ערך אחר כגון לסדר תמונות לפי הגודל שלהם, או משהו כזה]? שם אין לכם את כלי המיון של וורד, ואתם חייבים אלגוריתם כמו Bubble Sort. [אגב לפני שבועים היה לי כזה מקרה, ואני לא ידעתי על קיומו של אלגוריטם בועה, וחשבתי על הרבה זמן, איך ניתן לסדר, ובאמת יצא לי משהו מאד דומה לאגוריטם בועה, ואתמול גיליתי את השיטה של בועה, ושאני לא הגאון הראשון.]
                        בקיצור:
                        אני לא באמת חושב שהמאקרואים האלה יגרמו לכם לפרוץ בקריאות התפעלות, אבל הם כן תרגיל טוב למי שרוצה ללמוד VBA, ועשיתי את זה עם קצר הומור,
                        ואם זה לא מעניין אתכם – אז פשוט תעברו הלאה.

                        ו @דאנציג לגבי מה שכתבת

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

                        הייתי כותב לך שלא מתאים לך להעלות דברים של GPT...

                        לא הבנתי כוונתך באמת הקודים לא GPT כתב אותם, והקישור שהבאתי לכם על קורס VBA הוא אמיתי, באמת קורס מוצלח למי שזה מעניין אותו (אבל הוא באנגלית, ולא מסביר ממש למתחילים) יש להדגיש שזה הקורס היחיד שמצאתי על VBA לוורד, כולם מלמדים על אקסל ומתרגמים לוורד (אף אני כשהתחלתי עם VBA עשיתי כך בלית ברירה)

                        P מנותק
                        P מנותק
                        pcinfogmach
                        מדריכים
                        כתב נערך לאחרונה על ידי pcinfogmach
                        #201

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

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

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

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

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

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

                        menajemmendelM תגובה 1 תגובה אחרונה
                        0
                        • P pcinfogmach

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

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

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

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

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

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

                          menajemmendelM מנותק
                          menajemmendelM מנותק
                          menajemmendel
                          כתב נערך לאחרונה על ידי menajemmendel
                          #202

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

                          תגובה 1 תגובה אחרונה
                          1
                          • מ מנותק
                            מ מנותק
                            מניין
                            כתב נערך לאחרונה על ידי
                            #203

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

                            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
                            
                            
                            תגובה 1 תגובה אחרונה
                            5
                            • מ מניין

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

                              Sub סימון_תחילת_וסוף_עמוד()
                                  On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
                                  Dim doc As Document
                                  Dim rng As Range
                                  Dim pageCount As Integer
                                  Dim i As Integer
                                  Dim firstWord As Range
                                  Dim lastWord As Range
                                  Dim secondLastWord As Range
                                  Dim lastWordEnd As Long
                                  Dim firstWordEnd As Long
                                  Dim hasPunctuation As Boolean
                                  
                                  Application.UndoRecord.StartCustomRecord
                                  ' קבלת המסמך הפעיל
                                  Set doc = ActiveDocument
                                  pageCount = doc.ComputeStatistics(wdStatisticPages)
                                  
                                  ' מעבר על כל עמוד במסמך
                                  For i = 1 To pageCount
                                      ' הגדרת טווח העמוד
                                      Set rng = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
                                      rng.End = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i + 1).Start
                                      rng.End = rng.End - 1 ' להוציא את הסימן של עמוד חדש
                                      
                                      ' סימון המילה הראשונה
                                      Set firstWord = rng.Words(1)
                                      firstWordEnd = firstWord.End
                                      firstWord.font.Color = RGB(1, 255, 1) ' צבע ירוק בהיר
                                      
                                      ' סימון המילה האחרונה
                                      Set lastWord = rng.Words(rng.Words.Count)
                                      lastWordEnd = lastWord.End
                                      
                                      ' בדוק אם יש סימן פיסוק בסוף המילה האחרונה
                                      hasPunctuation = InStr(".!?," & Chr(34), Mid(lastWord.Text, Len(lastWord.Text), 1)) > 0
                                      
                                      If hasPunctuation Then
                                          ' אם יש סימן פיסוק, צובע את שתי המילים האחרונות
                                          If rng.Words.Count > 1 Then
                                              Set secondLastWord = rng.Words(rng.Words.Count - 1)
                                              secondLastWord.font.Color = RGB(255, 1, 1) ' צבע אדום בהיר
                                          End If
                                          lastWord.font.Color = RGB(255, 1, 1) ' צבע אדום בהיר
                                      Else
                                          ' אם אין סימן פיסוק, צובע רק את המילה האחרונה
                                          lastWord.font.Color = RGB(255, 1, 1) ' צבע אדום בהיר
                                      End If
                                  Next i
                                  
                                  MsgBox "המאקרו הסתיים בהצלחה!", vbInformation
                                  Application.UndoRecord.EndCustomRecord
                                  Exit Sub
                                  
                              ErrorHandler:
                                  Application.UndoRecord.EndCustomRecord
                                  MsgBox "אירעה שגיאה: " & Err.Description, vbCritical, "שגיאה"
                              End Sub
                              Sub חיפוש_סימונים_שלא_במקומם()
                                  Static currentPage As Integer
                                  Static errorsFound As Boolean
                                  Dim doc As Document
                                  Dim rng As Range
                                  Dim pageCount As Integer
                                  Dim i As Integer
                                  Dim firstWord As Range
                                  Dim startOfPageColor As Long
                              
                                  ' צבע לבדיקה
                                  startOfPageColor = RGB(1, 255, 1) ' ירוק בהיר
                              
                                  ' אתחול משתנים
                                  Set doc = ActiveDocument
                                  pageCount = doc.ComputeStatistics(wdStatisticPages)
                              
                                  ' התחלת בדיקה מהעמוד הראשון אם זה ההפעלה הראשונה
                                  If currentPage = 0 Then
                                      currentPage = 1
                                      errorsFound = False ' איפוס מצב שגיאות
                                  End If
                              
                                  ' מעבר על עמודים מהעמוד הנוכחי עד סוף המסמך
                                  For i = currentPage To pageCount
                                      ' הגדרת טווח עמוד
                                      Set rng = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, count:=i)
                                      rng.End = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, count:=i + 1).Start - 1
                              
                                      ' בדיקה אם יש מילים בעמוד
                                      If rng.Words.count > 0 Then
                                          ' קבלת המילה הראשונה בדיוק מתחילת העמוד
                                          Set firstWord = rng.Words(1)
                                          If firstWord.Information(wdActiveEndPageNumber) = i Then
                                              ' בדיקת צבע המילה הראשונה
                                              If firstWord.font.Color <> startOfPageColor Then
                                                  firstWord.Select
                                                  errorsFound = True ' נמצאה שגיאה
                                                  currentPage = i + 1 ' שמירת המיקום להמשך החיפוש
                                                  Exit Sub
                                              End If
                                          End If
                                      End If
                                  Next i
                              
                                  ' אם הגענו לסוף המסמך
                                  If errorsFound Then
                                      MsgBox "החיפוש הסתיים, לא נמצאו עמודים נוספים שהשתנו", vbInformation
                                  Else
                                      MsgBox "החיפוש הסתיים ולא נמצאו עמודים שהשתנו", vbInformation
                                  End If
                              
                                  ' איפוס המיקום והסטטוס לבדיקות חדשות
                                  currentPage = 0
                                  errorsFound = False
                              End Sub
                              Sub הסרת_הצבעים_המיוחדים()
                                  On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
                                  Dim doc As Document
                                  Dim rng As Range
                                  Dim i As Integer
                                  Dim word As Range
                                  
                                  ' קבלת המסמך הפעיל
                                  Set doc = ActiveDocument
                                  
                                  ' מעבר על כל המילים במסמך
                                  For Each rng In doc.StoryRanges
                                      Do
                                          For Each word In rng.Words
                                              ' אם הצבע אדום בהיר או ירוק בהיר, נסיר אותו
                                              If word.font.Color = RGB(1, 255, 1) Or word.font.Color = RGB(255, 1, 1) Then
                                                  word.font.Color = wdColorAutomatic
                                              End If
                                          Next word
                                          Set rng = rng.NextStoryRange
                                      Loop While Not rng Is Nothing
                                  Next rng
                                  
                                  MsgBox "הצבעים הוסרו בהצלחה!", vbInformation
                                  Exit Sub
                                  
                              ErrorHandler:
                                  MsgBox "אירעה שגיאה: " & Err.Description, vbCritical, "שגיאה"
                              End Sub
                              

                              עריכה: לבקשת @שלמה11 כאן שיניתי את הצבעים ללא רגילים כדי שיהיה אפשרות להסרה קלה.
                              נוסף לחצן לבדיקת כל המסמך אם כל הסימנים נשארו במקומם הנכון.
                              וכן נוסף לחצן להסרת הצבעים.
                              כמו כן נוסף אפשרות לבטל דרך קונטרול z. ועוד שיפורים

                              ש מנותק
                              ש מנותק
                              שלמה11
                              כתב נערך לאחרונה על ידי
                              #204

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

                              מאקרו שצובע את המילה הראשונה של כל עמוד בירוק ואת המילה האחרונה באדום, נצרך מאוד לתיקונים לאחר עימוד כדי לוודא שלא קפצו מילים לעמוד הבא.

                              אולי כדאי לצבוע את המילה הראשונה/האחרונה לא בצבע אדום/ירוק רגיל אלא:
                              Font.Color = RGB(255, 1, 1)
                              Font.Color = RGB(1, 255, 1)
                              ואז יהיה אפשר לעשות מאקרו של הסרה, מבלי לפגוע בטקסטים אחרים שצבועים באדום/ירוק

                              מ תגובה 1 תגובה אחרונה
                              2
                              • ש שלמה11

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

                                מאקרו שצובע את המילה הראשונה של כל עמוד בירוק ואת המילה האחרונה באדום, נצרך מאוד לתיקונים לאחר עימוד כדי לוודא שלא קפצו מילים לעמוד הבא.

                                אולי כדאי לצבוע את המילה הראשונה/האחרונה לא בצבע אדום/ירוק רגיל אלא:
                                Font.Color = RGB(255, 1, 1)
                                Font.Color = RGB(1, 255, 1)
                                ואז יהיה אפשר לעשות מאקרו של הסרה, מבלי לפגוע בטקסטים אחרים שצבועים באדום/ירוק

                                מ מנותק
                                מ מנותק
                                מניין
                                כתב נערך לאחרונה על ידי מניין
                                #205

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

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

                                מאקרו שצובע את המילה הראשונה של כל עמוד בירוק ואת המילה האחרונה באדום, נצרך מאוד לתיקונים לאחר עימוד כדי לוודא שלא קפצו מילים לעמוד הבא.

                                אולי כדאי לצבוע את המילה הראשונה/האחרונה לא בצבע אדום/ירוק רגיל אלא:
                                Font.Color = RGB(255, 1, 1)
                                Font.Color = RGB(1, 255, 1)
                                ואז יהיה אפשר לעשות מאקרו של הסרה, מבלי לפגוע בטקסטים אחרים שצבועים באדום/ירוק

                                עודכן כאן בתוספת מאקרו להסרה

                                תגובה 1 תגובה אחרונה
                                1
                                • מ מניין התייחס לנושא זה
                                • מ מניין

                                  מאקרו שמחזיר לטור אחד לפי סוג כותרת [משוכלל הרבה יותר מהמאקרו הקודם שמחזיר רק לפי מרכוז], יש אפשרות להחיל את המאקרו רק על פיסקא אחת או על כל המסמך, ומוחק כל המעברים המיותרים.
                                  הוראות:

                                  1. קודם כל צריך לפרוס את כל המסמך לשני טורים ולכוון את המרווחים.
                                  2. לוחצים על הלחצן 'מחזיר לטור אחד לפי כותרת' ושואל איזה סגנון רוצים להחזיר לטור אחד.
                                  3. שואל אם רוצים רק על פיסקא אחת או על כל המסמך, וכמובן אפשר ללחוץ על ביטול.
                                  4. המאקרו מנקה אוטומטי את כל סוגי הכפילויות שנוצרות בגלל הפעולה.
                                  5. אם רוצים אפשר לבטל הכל בלחיצה על קונטרול Z.
                                  6. יש אפשרות לעשות את הפעולה גם על כמה סגנונות בכל פעם על סגנון אחר או לחזור על אותו סגנון, והמאקרו מוחקת כל הכפילויות.
                                  7. אם רוצים להסיר ולהחזיר לשני טורים, יש לחצן נוסף 'מבטל פסקאות שעוצבו לטור אחד ומחזיר לשני טורים', יש שאלת בחירה לאחת משתי אפשרויות, או לבטל במקום אחד, או לבטל הכל בכל המסמך [במקרה שהסתבך, גם בזה יש אפשרות ביטול בלחיצה אחת קונטרול Z].
                                  Sub מחזיר_לטור_אחד_לפי_כותרת()
                                      Dim Alerts As Boolean
                                      Dim a As Boolean
                                      Dim headingName As String
                                      Dim para As paragraph
                                      Dim section As section
                                      Dim inSelectedHeading As Boolean
                                      Dim userChoice As VbMsgBoxResult
                                      Dim deleteParagraphBreaks As VbMsgBoxResult
                                      On Error GoTo ErrorHandler
                                      Application.UndoRecord.StartCustomRecord "החזרת לטור אחד לפי כותרת"
                                      Alerts = Application.DisplayAlerts
                                      Application.DisplayAlerts = wdAlertsNone
                                      Application.ScreenUpdating = False
                                      headingName = InputBox("הזן את שם הכותרת שברצונך לשנות לטור אחד:", "בחירת כותרת")
                                      If headingName = "" Then
                                          MsgBox "לא הוזנה כותרת. הפעולה בוטלה.", vbExclamation
                                          Exit Sub
                                      End If
                                      userChoice = MsgBox("האם ברצונך להחיל את השינוי על כל המסמך?", vbYesNoCancel + vbQuestion, "בחירת היקף פעולה")
                                      If userChoice = vbCancel Then
                                          MsgBox "הפעולה בוטלה.", vbExclamation
                                          Exit Sub
                                      End If
                                      If userChoice = vbNo Then
                                          Selection.MoveDown Unit:=wdParagraph, count:=1
                                      Else
                                          Selection.HomeKey Unit:=wdStory
                                      End If
                                      Do
                                          Selection.Find.ClearFormatting
                                          With Selection.Find
                                              .Style = headingName
                                              .Text = "^$"
                                              .Forward = True
                                              .Wrap = wdFindStop
                                              .Format = True
                                              .MatchCase = False
                                              .MatchWholeWord = False
                                              .MatchControl = False
                                              .MatchWildcards = False
                                              .MatchSoundsLike = False
                                              .MatchAllWordForms = False
                                          End With
                                          a = Selection.Find.Execute
                                          If a = True Then
                                              Selection.Paragraphs(1).Range.Select
                                              ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                                                  InsertBreak Type:=wdSectionBreakContinuous
                                              Selection.Start = Selection.Start + 1
                                              ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                                                  Type:=wdSectionBreakContinuous
                                              With Selection.pageSetup.TextColumns
                                                  .SetCount numColumns:=1
                                                  .EvenlySpaced = True
                                                  .LineBetween = False
                                              End With
                                              Selection.MoveRight Unit:=wdCharacter, count:=1
                                          End If
                                      Loop While a = True And (userChoice = vbYes)
                                      Call מחיקת_מעברים_מיותרים
                                      Selection.HomeKey Unit:=wdStory
                                      MsgBox "הפעולה הושלמה! ניתן לבטל את כל השינויים באמצעות Ctrl+Z.", vbInformation
                                  Cleanup:
                                      Application.DisplayAlerts = Alerts
                                      Application.ScreenUpdating = True
                                      Application.UndoRecord.EndCustomRecord
                                      Exit Sub
                                  ErrorHandler:
                                      MsgBox "אירעה שגיאה: " & Err.Description, vbCritical
                                      Resume Cleanup
                                  End Sub
                                  Private Sub מחיקת_מעברים_מיותרים()
                                      Dim sectionBreakRange As Range
                                      Dim paraBefore As Range
                                      Dim paraAfter As Range
                                      Application.ScreenUpdating = False
                                      Selection.HomeKey Unit:=wdStory
                                      If Selection.Find.Execute(FindText:="^b", MatchWildcards:=False, Forward:=True, Wrap:=wdFindStop) = True Then
                                          If Selection.Start = 0 Then
                                              Selection.Delete
                                          End If
                                      End If
                                      Dim found As Boolean
                                      Dim specialChar As String: specialChar = ";~;"
                                      Selection.HomeKey Unit:=wdStory
                                      With Selection.Find
                                          .ClearFormatting: .Text = "^b^b": .Forward = True: .Wrap = wdFindStop: .Format = False: .MatchWildcards = False
                                      End With
                                      Do While Selection.Find.Execute
                                          Selection.Collapse Direction:=wdCollapseEnd: Selection.TypeText Text:=specialChar
                                      Loop
                                      Selection.HomeKey Unit:=wdStory
                                      With Selection.Find
                                          .ClearFormatting: .Text = "^b" & specialChar: .Forward = True: .Wrap = wdFindStop: .Format = False: .MatchWildcards = False
                                      End With
                                      Do While Selection.Find.Execute
                                          Selection.Delete
                                      Loop
                                      Selection.HomeKey Unit:=wdStory
                                      With Selection.Find
                                          .ClearFormatting: .Text = specialChar: .Forward = True: .Wrap = wdFindStop: .Format = False: .MatchWildcards = False
                                      End With
                                      Do While Selection.Find.Execute
                                          Selection.Delete
                                      Loop
                                      Selection.HomeKey Unit:=wdStory
                                      Do While Selection.Find.Execute(FindText:="^b", MatchWildcards:=False, Forward:=True, Wrap:=wdFindStop) = True
                                          Set sectionBreakRange = Selection.Range
                                          If sectionBreakRange.Start > 0 Then
                                              On Error Resume Next
                                              Set paraBefore = sectionBreakRange.Paragraphs(1).Range.Previous(wdParagraph, 1)
                                              Set paraAfter = sectionBreakRange.Paragraphs(1).Range.Next(wdParagraph, 1)
                                              On Error GoTo 0
                                              If Not paraBefore Is Nothing And Not paraAfter Is Nothing Then
                                                  If paraBefore.pageSetup.TextColumns.count = 1 And _
                                                     paraAfter.pageSetup.TextColumns.count = 1 Then
                                                      sectionBreakRange.Delete
                                                  End If
                                              End If
                                          End If
                                          Selection.Start = sectionBreakRange.Start
                                          Selection.Collapse Direction:=wdCollapseEnd
                                      Loop
                                      Application.ScreenUpdating = True
                                  End Sub
                                  Sub מבטל_פסקאות_שעוצבו_לטור_אחד_ומחזיר_לשני_טורים()
                                      On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
                                      Dim userChoice As VbMsgBoxResult
                                      userChoice = MsgBox("מחזיר פיסקא נוכחית לשני טורים. האם ברצונך לעשות פעולה זו על כל המסמך?", vbYesNo + vbQuestion, "מחיקת מעברי מקטע")
                                      If userChoice = vbYes Then
                                          Call מחיקת_מעברי_מקטע_בכל_המסמך
                                      ElseIf userChoice = vbNo Then
                                          Call מחיקת_מעברי_מקטע_בפסקא_נוכחית
                                      Else
                                          MsgBox "הפעולה בוטלה.", vbInformation
                                      End If
                                      Exit Sub
                                  
                                  ErrorHandler:
                                      MsgBox "אירעה שגיאה: " & Err.Description, vbCritical, "שגיאה"
                                  End Sub
                                  Private Sub מחיקת_מעברי_מקטע_בכל_המסמך()
                                      On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
                                      Dim para As paragraph
                                      Dim paraRange As Range
                                      Dim sectionRange As Range
                                      Application.UndoRecord.StartCustomRecord
                                      Application.ScreenUpdating = False
                                      Selection.HomeKey Unit:=wdStory
                                      For Each para In ActiveDocument.Paragraphs
                                          Set paraRange = para.Range
                                          If paraRange.pageSetup.TextColumns.count = 1 Then
                                              Set sectionRange = paraRange.Duplicate
                                              sectionRange.Collapse wdCollapseEnd
                                              sectionRange.MoveEnd Unit:=wdCharacter, count:=1
                                              
                                              If sectionRange.Text = Chr(12) Then
                                                  sectionRange.Delete
                                                  With ActiveDocument.Range(paraRange.Start - 1, paraRange.Start)
                                                      If .Text = Chr(12) Then
                                                          .Delete
                                                      End If
                                                  End With
                                              End If
                                          End If
                                      Next para
                                      MsgBox "הפעולה הסתיימה בהצלחה על כל המסמך", vbInformation
                                      Application.ScreenUpdating = True
                                      Application.UndoRecord.EndCustomRecord
                                      Exit Sub
                                  
                                  ErrorHandler:
                                      Application.ScreenUpdating = True
                                      Application.UndoRecord.EndCustomRecord
                                      MsgBox "אירעה שגיאה: " & Err.Description, vbCritical, "שגיאה"
                                  End Sub
                                  
                                  Private Sub מחיקת_מעברי_מקטע_בפסקא_נוכחית()
                                      On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
                                      Dim currentPara As paragraph
                                      Dim paraRange As Range
                                      Dim sectionRange As Range
                                      Application.UndoRecord.StartCustomRecord
                                      Application.ScreenUpdating = False
                                      If Selection.Range.Paragraphs.count = 0 Then
                                          MsgBox "נא לעמוד בתוך פסקה בטור אחד.", vbExclamation
                                          GoTo Cleanup
                                      End If
                                      Set currentPara = Selection.Range.Paragraphs(1)
                                      Set paraRange = currentPara.Range
                                      If currentPara.Range.pageSetup.TextColumns.count <> 1 Then
                                          MsgBox "נא לעמוד בפסקה בטור אחד בלבד.", vbExclamation
                                          GoTo Cleanup
                                      End If
                                      Set sectionRange = paraRange.Duplicate
                                      sectionRange.Collapse wdCollapseEnd
                                      sectionRange.MoveEnd Unit:=wdCharacter, count:=1
                                      If sectionRange.Text <> Chr(12) Then
                                          MsgBox "נא לעמוד בפסקה האחרונה לפני מעבר לשני טורים.", vbExclamation
                                          GoTo Cleanup
                                      End If
                                      sectionRange.Delete
                                      With Selection.Find
                                          .ClearFormatting
                                          .Text = "^b"
                                          .Forward = False
                                          .Wrap = wdFindStop
                                          If .Execute Then Selection.Delete
                                      End With
                                      MsgBox "הפעולה הושלמה בהצלחה עבור הפסקה הנוכחית", vbInformation
                                  
                                  Cleanup:
                                      Application.ScreenUpdating = True
                                      Application.UndoRecord.EndCustomRecord
                                      Exit Sub
                                  
                                  ErrorHandler:
                                      Application.ScreenUpdating = True
                                      Application.UndoRecord.EndCustomRecord
                                      MsgBox "אירעה שגיאה: " & Err.Description, vbCritical, "שגיאה"
                                  End Sub
                                  

                                  שוה בדיקה

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

                                  menajemmendelM מנותק
                                  menajemmendelM מנותק
                                  menajemmendel
                                  כתב נערך לאחרונה על ידי menajemmendel
                                  #206

                                  @מניין אני רואה שבכמה מאקרו אתה מוסיף את האפשרות של ביטול פעולה אחרונה, וזה מאד עוזר, אבל חשוב מאד, לדעת שאם אתה מוסיף את זה אז עוד יותר חשוב להוסיף גם error handeling, כמו שהסברתי כאן (אחרת עלול לגרום לבעיות שאחריתם מי ישורנו)

                                  מ תגובה 1 תגובה אחרונה
                                  3
                                  • menajemmendelM menajemmendel

                                    @מניין אני רואה שבכמה מאקרו אתה מוסיף את האפשרות של ביטול פעולה אחרונה, וזה מאד עוזר, אבל חשוב מאד, לדעת שאם אתה מוסיף את זה אז עוד יותר חשוב להוסיף גם error handeling, כמו שהסברתי כאן (אחרת עלול לגרום לבעיות שאחריתם מי ישורנו)

                                    מ מנותק
                                    מ מנותק
                                    מניין
                                    כתב נערך לאחרונה על ידי מניין
                                    #207

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

                                    @מניין אני רואה שבכמה מאקרו אתה מוסיף את האפשרות של ביטול פעולה אחרונה, וזה מאד עוזר, אבל חשוב מאד, לדעת שאם אתה מוסיף את זה אז עוד יותר חשוב להוסיף גם error handeling, כמו שהסברתי כאן (אחרת עלול לגרום לבעיות שאחריתם מי ישורנו)

                                    עודכן כאן וגם כאן

                                    תגובה 1 תגובה אחרונה
                                    0
                                    • מ מניין התייחס לנושא זה
                                    • P pcinfogmach

                                      בס"ד
                                      פוסט מסודר עבור העלאת מאקרואים לוורד


                                      הנחיות עבור עורכי פוסטים

                                      כל מי שיכול להעלות מאקרואים לתועלת הציבור נא להעלות כאן
                                      תגובות לנושא זה יש לכתוב כאן בשרשור התגובות כמו"כ ניתן למצוא הוראות נוספות להכנת מאקרו בשרשור התגובות.

                                      שים לב! שרשור זה נועד עבור המשתמש הפשוט לכן אבקש מכולם נא לא להעלות כאן קודים אלא רק מאקרו מוכן בתוך תבנית - כדי שכולם יוכלו להשתמש בהם בקלות. כפי שיפורט להלן, מאוד קל להתקין בוורד מאקרו מוכן באופן זה.
                                      להוראות כיצד להכין תבנית עם מאקרו לחץ כאן
                                      מי שיכול אבקש ממנו שיכין את המאקרו בתוך קובץ לחילוץ עצמי שיחלץ את הקבצים למקום הראוי %AppData%/Microsoft/Word/STARTUP
                                      עיין כאן להוראות איך מכינים קובץ לחילוץ עצמי


                                      תוכן העניינים

                                      תוכן העניינים אינו כולל הכול ומעדכן מידי פעם.

                                      1. מאקרו יישור טורים בוורד
                                      2. מאקרו תיקון שגיאות נפוצות
                                      3. תבנית מחיקת פסקאות ריקות ורווח לפני פסקא
                                      4. הערות ברצף
                                      5. שילוב של כמה מאקרוים: (הקטנת והגדלת סוגריים על כל המסמך. עריכת הפניות מקושרות. עדכון הפניות מקושרות. מעבר בין מקטעים. המרת הפניות לתג).
                                      6. סימון שגיאה בטקסט על ידי ..?
                                      7. תיקון שגיאות מנצפך ועוד שיבושים נוספים
                                      8. עיצוב ספרי קודש
                                      9. עיצוב אוטומטי של ההערות שוליים כנהוג ברוב ספרי הקודש
                                      10. חיפוש והחלפה פרטניים
                                      11. עיצוב כל כותרות בטור אחד במסמך של שני טורים
                                      12. מעבר עמוד לפני כותרת
                                      13. מאקרו שמוסיף שדה למיספור אוטומטי (שימושי מאוד לספר עם סימנים רבים, ובכל סימן יש סעיפים)
                                      14. מאקרו מעבר מהערה למסמך ולהיפך, וכן מאקרו ליצירת אינדקס בקלות
                                      15. קוד VBA להמיר בוורד ממספרים לאותיות, רגיל ובלשון נקייה.
                                      16. שינוי מרווח טורים רק בהערות שוליים
                                      17. החלפת שדה נבחר למספור אוטומטי אותיות
                                      18. המרת מספרים לאותיות עם לשון נקיה
                                      19. חיפוש ותיקון סוגריים לא סגורים
                                        - תיקון סוגריים גירסה 2
                                      20. מאקרו לגיבוי התבנית normal (הגדרות ברירת המחדל)
                                      21. חילוץ טקסט - מפרק את כל ההערות שבמסמך [בלון, שוליים, הערות] למסמכים נפרדים, ומשאיר הפניות במסמך המקורי, עיצוב לבחירת המשתמש.
                                      22. מאקרו לוורד להצגת כל קיצורי המקשים המותאמים אישית: - והתבנית המוכנה כאן: https://mitmachim.top/post/641294
                                      23. החלפת אות, מילה, או פיסקה עם הסמוכה לה
                                      24. הערות שולים - מספור בעברית עד 1200
                                      25. קבלת הקוד של התיו המסומן לתורך שימוש בחיפוש והחלפה
                                      26. פתרון באג שצג
                                      27. המרה הוספה ועריכה שדה מספור אוטומטי
                                      28. מספור עברי מעל שצב
                                      29. חיפוש והחלפה באבני בניין
                                      30. מאקרו הפניה מקושרת אינדקס תצוגת טויטה.
                                      31. מאקרו שצובע את המילה הראשונה של כל עמוד בירוק ואת המילה האחרונה באדום, נצרך מאוד לתיקונים לאחר עימוד כדי לוודא שלא קפצו מילים לעמוד הבא.
                                      32. מאקרו הדפסה לפי רשימה
                                      33. מאקרו להסתרת טקסט
                                      34. הפניה מקושרת ממסמך למסמך
                                      35. הוספת עיטור לפני או אחרי כותרת
                                      36. מאקרו צמצום מסמך בוורד
                                      37. מאקרו איזון שורה אחרונה - מילה אחרונה תלושה

                                      הוראות להתקנת מאקרו בקלות

                                      להוראות כלליות לגבי מאקרו ניתן לעיין כאן

                                      כדי להתקין מאקרו בוורד בקלות

                                      1. יש להוריד את התבנית הרצויה (תבניות יובאו בפוסטים בהמשך השרשור)

                                      2. יש להעתיק את התבנית אל תוך התיקייה הזו:
                                        AppData%\Microsoft\Word\STARTUP%
                                        (אפשר ללחוץ על "מקש-חלונות + R" ולהזין שם את הכתובת הנ"ל)
                                        - רוצים להסיר מאקרו? פשוט מחקו אותו מהתיקייה הנ"ל.

                                      אפשרות התקנה חילופית:
                                      יש לפתוח את המאקרו ולאחמ"כ יש לעבור ללשונית 'תצוגה', בצד שמאל יש ללחוץ על 'פקודות מאקרו', בחלון שנפתח יש ללחוץ בצד שמאל על 'סדרן' ולהעתיק את המאקרו מהחלונית הימנית לשמאלית, להעברת המאקרו לתבנית נורמל (Normal).
                                      כדי למחוק מאקרו שהותקן בצורה זו יש לבחור במחק שבחלון זה.

                                      1. כעת המאקרו שבתבנית יהיו זמינים לכם בכל מסמך שתרצו

                                      2. כדי להריץ מאקרו יש להיכנס לכרטיססית תצוגה בוורד > פקודות מאקרו > הצג פקודות מאקרו ( או ללחוץ ALT +F8).

                                      f56ec072-2f64-4745-b9d1-7c338a06c584-image.png

                                      כעת בחרו במאקרו המתאים ולחצו על הפעל.


                                      איך ליצור קיצורי דרך למאקרו בקלות

                                      אפשר גם ליצור קיצורי דרך (קיצורי מקשים או לחצן) עבור כל מאקרו שתירצו וכדלהלן:

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

                                      c83f3ddb-b2e4-4752-859f-470a2a64af88-image.png

                                      9af5da5d-f045-4687-8eba-fd015e92d0e5-image.png

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

                                      076e7ded-3ca5-484f-ae28-6b1190c978af-image.png

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

                                      בהצלחה!

                                      י מנותק
                                      י מנותק
                                      יאיר דניאל
                                      כתב נערך לאחרונה על ידי יאיר דניאל
                                      #208

                                      @pcinfogmach מצורף מאקרו תיקון שגיאות - קצת שונה ממה שכבר העלת כאן מ @א.מ
                                      מכיוון שאני לא יודע איך סוגרים אותו, וגם בכדי שיכולו לעבור עליו - אני מצרף אותו גם בתוך קובץ TXT.
                                      (יש שם כמה דברים שמיועדים למי שמשתמש עם תיקון שגיאות אוטומטי (https://mitmachim.top/topic/78023/להורדה-תיקון-שגיאות-אוטומטי-בוורד/19)

                                      תיקון סימנים כפולים.txt

                                      ||Sub תיקון_סימנים_כפולים()
                                      '
                                      ' תיקון_סימנים_כפולים Macro
                                      '
                                      '
                                      Selection.Find.ClearFormatting
                                      Selection.Find.Replacement.ClearFormatting
                                      With Selection.Find
                                      .Text = ".."
                                      .Replacement.Text = "."
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                      .Text = ",,"
                                      .Replacement.Text = ","
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                      .Text = "''"
                                      .Replacement.Text = "'"
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                      .Text = " "
                                      .Replacement.Text = " "
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                      .Text = " ,"
                                      .Replacement.Text = ","
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                      .Text = " ."
                                      .Replacement.Text = "."
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                      .Text = " """
                                      .Replacement.Text = """"
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                      .Text = """"""
                                      .Replacement.Text = """"
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                      .Text = "ייי"
                                      .Replacement.Text = "יי"
                                      .Forward = True
                                      .Wrap = wdFindContinue
                                      .Format = False
                                      .MatchCase = False
                                      .MatchWholeWord = False
                                      .MatchKashida = False
                                      .MatchDiacritics = False
                                      .MatchAlefHamza = False
                                      .MatchControl = False
                                      .MatchWildcards = False
                                      .MatchSoundsLike = False
                                      .MatchAllWordForms = False
                                      End With

                                      Selection.Find.Replacement.ClearFormatting
                                      Selection.Find.Replacement.Font.Color = wdColorRed
                                      With Selection.Find
                                          .Text = "^$צ "
                                          .Replacement.Text = "^&"
                                          .Forward = True
                                          .Wrap = wdFindContinue
                                          .Format = True
                                          .MatchCase = False
                                          .MatchWholeWord = False
                                          .MatchKashida = False
                                          .MatchDiacritics = False
                                          .MatchAlefHamza = False
                                          .MatchControl = False
                                          .MatchWildcards = False
                                          .MatchSoundsLike = False
                                          .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                          .Text = "^$מ "
                                          .Replacement.Text = "^&"
                                          .Forward = True
                                          .Wrap = wdFindContinue
                                          .Format = True
                                          .MatchCase = False
                                          .MatchWholeWord = False
                                          .MatchKashida = False
                                          .MatchDiacritics = False
                                          .MatchAlefHamza = False
                                          .MatchControl = False
                                          .MatchWildcards = False
                                          .MatchSoundsLike = False
                                          .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                          .Text = "^$פ "
                                          .Replacement.Text = "^&"
                                          .Forward = True
                                          .Wrap = wdFindContinue
                                          .Format = True
                                          .MatchCase = False
                                          .MatchWholeWord = False
                                          .MatchKashida = False
                                          .MatchDiacritics = False
                                          .MatchAlefHamza = False
                                          .MatchControl = False
                                          .MatchWildcards = False
                                          .MatchSoundsLike = False
                                          .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                          .Text = "^$נ "
                                          .Replacement.Text = "^&"
                                          .Forward = True
                                          .Wrap = wdFindContinue
                                          .Format = True
                                          .MatchCase = False
                                          .MatchWholeWord = False
                                          .MatchKashida = False
                                          .MatchDiacritics = False
                                          .MatchAlefHamza = False
                                          .MatchControl = False
                                          .MatchWildcards = False
                                          .MatchSoundsLike = False
                                          .MatchAllWordForms = False
                                      End With
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      With Selection.Find
                                          .Text = "^$כ "
                                          .Replacement.Text = "^&"
                                          .Forward = True
                                          .Wrap = wdFindContinue
                                          .Format = True
                                          .MatchCase = False
                                          .MatchWholeWord = False
                                          .MatchKashida = False
                                          .MatchDiacritics = False
                                          .MatchAlefHamza = False
                                          .MatchControl = False
                                          .MatchWildcards = False
                                          .MatchSoundsLike = False
                                          .MatchAllWordForms = False
                                      End Wit
                                      Selection.Find.Execute Replace:=wdReplaceAll
                                      

                                      ||ספויילר

                                      אשמח לשיפורים, הערות, והארות

                                      תגובה 1 תגובה אחרונה
                                      1
                                      • מ מניין

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

                                        Sub סימון_תחילת_וסוף_עמוד()
                                            On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
                                            Dim doc As Document
                                            Dim rng As Range
                                            Dim pageCount As Integer
                                            Dim i As Integer
                                            Dim firstWord As Range
                                            Dim lastWord As Range
                                            Dim secondLastWord As Range
                                            Dim lastWordEnd As Long
                                            Dim firstWordEnd As Long
                                            Dim hasPunctuation As Boolean
                                            
                                            Application.UndoRecord.StartCustomRecord
                                            ' קבלת המסמך הפעיל
                                            Set doc = ActiveDocument
                                            pageCount = doc.ComputeStatistics(wdStatisticPages)
                                            
                                            ' מעבר על כל עמוד במסמך
                                            For i = 1 To pageCount
                                                ' הגדרת טווח העמוד
                                                Set rng = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
                                                rng.End = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i + 1).Start
                                                rng.End = rng.End - 1 ' להוציא את הסימן של עמוד חדש
                                                
                                                ' סימון המילה הראשונה
                                                Set firstWord = rng.Words(1)
                                                firstWordEnd = firstWord.End
                                                firstWord.font.Color = RGB(1, 255, 1) ' צבע ירוק בהיר
                                                
                                                ' סימון המילה האחרונה
                                                Set lastWord = rng.Words(rng.Words.Count)
                                                lastWordEnd = lastWord.End
                                                
                                                ' בדוק אם יש סימן פיסוק בסוף המילה האחרונה
                                                hasPunctuation = InStr(".!?," & Chr(34), Mid(lastWord.Text, Len(lastWord.Text), 1)) > 0
                                                
                                                If hasPunctuation Then
                                                    ' אם יש סימן פיסוק, צובע את שתי המילים האחרונות
                                                    If rng.Words.Count > 1 Then
                                                        Set secondLastWord = rng.Words(rng.Words.Count - 1)
                                                        secondLastWord.font.Color = RGB(255, 1, 1) ' צבע אדום בהיר
                                                    End If
                                                    lastWord.font.Color = RGB(255, 1, 1) ' צבע אדום בהיר
                                                Else
                                                    ' אם אין סימן פיסוק, צובע רק את המילה האחרונה
                                                    lastWord.font.Color = RGB(255, 1, 1) ' צבע אדום בהיר
                                                End If
                                            Next i
                                            
                                            MsgBox "המאקרו הסתיים בהצלחה!", vbInformation
                                            Application.UndoRecord.EndCustomRecord
                                            Exit Sub
                                            
                                        ErrorHandler:
                                            Application.UndoRecord.EndCustomRecord
                                            MsgBox "אירעה שגיאה: " & Err.Description, vbCritical, "שגיאה"
                                        End Sub
                                        Sub חיפוש_סימונים_שלא_במקומם()
                                            Static currentPage As Integer
                                            Static errorsFound As Boolean
                                            Dim doc As Document
                                            Dim rng As Range
                                            Dim pageCount As Integer
                                            Dim i As Integer
                                            Dim firstWord As Range
                                            Dim startOfPageColor As Long
                                        
                                            ' צבע לבדיקה
                                            startOfPageColor = RGB(1, 255, 1) ' ירוק בהיר
                                        
                                            ' אתחול משתנים
                                            Set doc = ActiveDocument
                                            pageCount = doc.ComputeStatistics(wdStatisticPages)
                                        
                                            ' התחלת בדיקה מהעמוד הראשון אם זה ההפעלה הראשונה
                                            If currentPage = 0 Then
                                                currentPage = 1
                                                errorsFound = False ' איפוס מצב שגיאות
                                            End If
                                        
                                            ' מעבר על עמודים מהעמוד הנוכחי עד סוף המסמך
                                            For i = currentPage To pageCount
                                                ' הגדרת טווח עמוד
                                                Set rng = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, count:=i)
                                                rng.End = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, count:=i + 1).Start - 1
                                        
                                                ' בדיקה אם יש מילים בעמוד
                                                If rng.Words.count > 0 Then
                                                    ' קבלת המילה הראשונה בדיוק מתחילת העמוד
                                                    Set firstWord = rng.Words(1)
                                                    If firstWord.Information(wdActiveEndPageNumber) = i Then
                                                        ' בדיקת צבע המילה הראשונה
                                                        If firstWord.font.Color <> startOfPageColor Then
                                                            firstWord.Select
                                                            errorsFound = True ' נמצאה שגיאה
                                                            currentPage = i + 1 ' שמירת המיקום להמשך החיפוש
                                                            Exit Sub
                                                        End If
                                                    End If
                                                End If
                                            Next i
                                        
                                            ' אם הגענו לסוף המסמך
                                            If errorsFound Then
                                                MsgBox "החיפוש הסתיים, לא נמצאו עמודים נוספים שהשתנו", vbInformation
                                            Else
                                                MsgBox "החיפוש הסתיים ולא נמצאו עמודים שהשתנו", vbInformation
                                            End If
                                        
                                            ' איפוס המיקום והסטטוס לבדיקות חדשות
                                            currentPage = 0
                                            errorsFound = False
                                        End Sub
                                        Sub הסרת_הצבעים_המיוחדים()
                                            On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
                                            Dim doc As Document
                                            Dim rng As Range
                                            Dim i As Integer
                                            Dim word As Range
                                            
                                            ' קבלת המסמך הפעיל
                                            Set doc = ActiveDocument
                                            
                                            ' מעבר על כל המילים במסמך
                                            For Each rng In doc.StoryRanges
                                                Do
                                                    For Each word In rng.Words
                                                        ' אם הצבע אדום בהיר או ירוק בהיר, נסיר אותו
                                                        If word.font.Color = RGB(1, 255, 1) Or word.font.Color = RGB(255, 1, 1) Then
                                                            word.font.Color = wdColorAutomatic
                                                        End If
                                                    Next word
                                                    Set rng = rng.NextStoryRange
                                                Loop While Not rng Is Nothing
                                            Next rng
                                            
                                            MsgBox "הצבעים הוסרו בהצלחה!", vbInformation
                                            Exit Sub
                                            
                                        ErrorHandler:
                                            MsgBox "אירעה שגיאה: " & Err.Description, vbCritical, "שגיאה"
                                        End Sub
                                        

                                        עריכה: לבקשת @שלמה11 כאן שיניתי את הצבעים ללא רגילים כדי שיהיה אפשרות להסרה קלה.
                                        נוסף לחצן לבדיקת כל המסמך אם כל הסימנים נשארו במקומם הנכון.
                                        וכן נוסף לחצן להסרת הצבעים.
                                        כמו כן נוסף אפשרות לבטל דרך קונטרול z. ועוד שיפורים

                                        ש מנותק
                                        ש מנותק
                                        שלמה11
                                        כתב נערך לאחרונה על ידי
                                        #209

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

                                        Sub הסרת_הצבעים_המיוחדים()
                                        On Error GoTo ErrorHandler ' הפעלת טיפול בשגיאות
                                        Dim doc As Document
                                        Dim rng As Range
                                        Dim i As Integer
                                        Dim word As Range

                                        ' קבלת המסמך הפעיל
                                        Set doc = ActiveDocument
                                        
                                        ' מעבר על כל המילים במסמך
                                        For Each rng In doc.StoryRanges
                                            Do
                                                For Each word In rng.Words
                                                    ' אם הצבע אדום בהיר או ירוק בהיר, נסיר אותו
                                                    If word.font.Color = RGB(1, 255, 1) Or word.font.Color = RGB(255, 1, 1) Then
                                                        word.font.Color = wdColorAutomatic
                                                    End If
                                                Next word
                                                Set rng = rng.NextStoryRange
                                            Loop While Not rng Is Nothing
                                        Next rng
                                        

                                        אני התכוונתי לזה:

                                        Sub FindGreenAndRedText()
                                            ' חיפוש טקסט בצבע ירוק
                                            With Selection.Find
                                                .ClearFormatting
                                                .Font.Color = RGB(1, 255, 1)
                                                .Text = ""
                                                .Replacement.Text = ""
                                                .Wrap = wdFindContinue
                                                .Format = True
                                                .Execute Replace:=wdReplaceNone
                                            End With
                                        
                                            ' חיפוש טקסט בצבע אדום
                                            With Selection.Find
                                                .ClearFormatting
                                                .Font.Color = RGB(255, 1, 1)
                                                .Text = ""
                                                .Replacement.Text = ""
                                                .Wrap = wdFindContinue
                                                .Format = True
                                                .Execute Replace:=wdReplaceNone
                                            End With
                                        End Sub
                                        
                                        
                                        
                                        תגובה 1 תגובה אחרונה
                                        0
                                        • י מנותק
                                          י מנותק
                                          יאיר דניאל
                                          כתב נערך לאחרונה על ידי
                                          #210

                                          איך עושים בחיפוש והחלפה, תיקון לשגיאות הבאות:
                                          ,א = אם יש פסיק ואז אות, שירד הפסיק לפני האות ויהיה אחריה.
                                          שלום(וברכה) = אם התו הפותח של סוגריים, צמוד למילה הקודמת - איך מכניסים ריווח לפני הסוגריים [החלף: "^$(" ב: "^& (" גורם שהתוצאה תהיה כך: "( (" ]
                                          שלום.(וברכה) = אם התו הפותח של סוגריים, צמוד לנקודה או פסיק - איך מכניסים ריווח לפני הסוגריים.
                                          שלום)וברכה = אם התו הסוגר של סוגריים, צמוד למילה הבאה - איך מכניסין ריווח אחרי הסוגריים.

                                          ח תגובה 1 תגובה אחרונה
                                          0

                                          • התחברות

                                          • אין לך חשבון עדיין? הרשמה

                                          • התחברו או הירשמו כדי לחפש.
                                          • פוסט ראשון
                                            פוסט אחרון
                                          0
                                          • חוקי הפורום
                                          • פופולרי
                                          • לא נפתר
                                          • משתמשים
                                          • חיפוש גוגל בפורום
                                          • צור קשר