דילוג לתוכן
  • חוקי הפורום
  • פופולרי
  • לא נפתר
  • משתמשים
  • חיפוש גוגל בפורום
  • צור קשר
עיצובים
  • 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.8k צפיות 32 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • P pcinfogmach

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

    (יש לציין שגם התוסף של @pcinfogmach עושה זאת בהערות שוליים).

    בגירסה הנוכחית כבר לא השתמשתי בשיטה זו גם בהערות שוליים

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

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

    P 2 תגובות תגובה אחרונה
    0
    • ד דאנציג

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

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

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

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

      את החלק הזה של הקוד גם קיבלתי מניק יוזר

      גמ"ח עזרה וייעוץ בנושאי מחשבים

      תגובה 1 תגובה אחרונה
      1
      • ד דאנציג

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

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

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

        אבל, בתיבת טקסט שניהם לא עובדים...

        ושל שלמה מימות כן?

        גמ"ח עזרה וייעוץ בנושאי מחשבים

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

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

          אבל, בתיבת טקסט שניהם לא עובדים...

          ושל שלמה מימות כן?

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

          @pcinfogmach כן

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

            חיפוש והחלפה באבני בניין
            חיפוש והחלפה עם אבני בניין.dotm

            גמ"ח עזרה וייעוץ בנושאי מחשבים

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

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

              תגובה 1 תגובה אחרונה
              4
              • ד דאנציג

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

                מאקרו מעבר מהערה למסמך ולהיפך, וכן מאקרו ליצירת אינדקס בקלות
                מעבר-מהערה-למסמך ואינדקס.dotm
                בהצלחה

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

                        ActiveWindow.View.SplitSpecial = wdPaneFootnotes
                

                וזה למעבר למסמך מההערה

                     ActiveWindow.View.SeekView = wdSeekMainDocument
                

                אגב, אני הוספתי את הפקודה הזו:
                d2f7b583-3eea-43df-9027-647e811bacb6-image.png
                לשורה למעלה, כך שלחיצה על ALT + 5 (אצלי) מביאה את אותה פונקציה בפקודה אחת, דהיינו לחיצה אחת יורדת להערה, ולחיצה נוספת מעלה בחזרה לטקסט, כך שלא צריך שתי פקודות מאקרו נפרדות (שתי קצורי מקשים).

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

                @דאנציג יכלת גם להגדיר לזה קיצור מקשים מותאם אישית... לשם הידע..

                תגובה 1 תגובה אחרונה
                0
                • A מנותק
                  A מנותק
                  ASDF1345
                  כתב ב נערך לאחרונה על ידי ASDF1345
                  #175

                  מצורף מסמך שמכיל מספר פקודות מאקרו: א. הפניה מקושרת ב. אינדקס ג. פקודות שקשורות לתצוגת טויטה
                  עריכה: מצורף קובץ יותר מעודכן מאקרו הפניה מקושרת אינדקס תצוגת טויטה.dotm

                  P תגובה 1 תגובה אחרונה
                  0
                  • A ASDF1345

                    מצורף מסמך שמכיל מספר פקודות מאקרו: א. הפניה מקושרת ב. אינדקס ג. פקודות שקשורות לתצוגת טויטה
                    עריכה: מצורף קובץ יותר מעודכן מאקרו הפניה מקושרת אינדקס תצוגת טויטה.dotm

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

                    @ASDF1345
                    מומלץ לציין מה בדיוק השתנה בעדכון

                    גמ"ח עזרה וייעוץ בנושאי מחשבים

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

                      @ASDF1345
                      מומלץ לציין מה בדיוק השתנה בעדכון

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

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

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

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

                        Sub סגנון_נוכחי_לתחילת_עמוד()
                        ' מחפש סגנון
                        Selection.Find.ClearFormatting
                        SIGNON = Selection.Style
                            With Selection.Find
                                .Text = ""
                                .Style = SIGNON
                                .Forward = True
                                .Wrap = wdFindAsk
                            End With
                            Selection.Find.Execute
                        'אחרי שמצא עובר אחוריו ועושה מעבר
                            Selection.MoveUp Unit:=wdParagraph, Count:=1
                            Selection.MoveLeft Unit:=wdCharacter, Count:=1
                            Selection.InsertBreak Type:=wdSectionBreakNextPage
                            Selection.Delete Unit:=wdCharacter, Count:=1
                            Selection.MoveRight Unit:=wdCharacter, Count:=1
                        
                            
                        End Sub
                        
                        
                        A מנותק
                        A מנותק
                        ASDF1345
                        כתב נערך לאחרונה על ידי ASDF1345
                        #178

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

                        Sub הוספת_מעבר_עמוד_לפי_סגנון_כל_המסמך()
                        '
                        ' הוספת_מעבר_עמוד_לפי_סגנון_כל_המסמך Macro
                        '
                        '
                        
                        Application.ScreenUpdating = False
                        
                        Selection.Find.ClearFormatting
                        SIGNON = Selection.Style
                        
                        Dim my_undo As Object
                        Set my_undo = Application.UndoRecord
                        my_undo.StartCustomRecord ("הוספת מעבר עמוד לפי סגנון")
                        On Error GoTo ending
                        
                        Dim rng, oRange As Range
                        Set rng = Selection.Range
                        
                        Selection.WholeStory
                        Set oRange = Selection.Range
                            
                            Selection.Find.ClearFormatting
                            Selection.Find.Replacement.ClearFormatting
                            With Selection.Find
                                .Text = "^p"
                                .Replacement.Text = "#^p"
                                .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
                            
                        start:
                        With Selection.Find
                            .ClearFormatting
                                .Text = "#"
                                .Style = SIGNON
                                .Forward = True
                                .Wrap = wdFindContinue
                                Selection.Find.Execute
                            
                            If Not Selection.Range.InRange(oRange) Then GoTo ext
                            If .Found = True Then
                            Selection.Delete Unit:=wdCharacter, Count:=1
                            Selection.HomeKey Unit:=wdLine
                            Selection.InsertBreak Type:=0
                            
                        GoTo start
                            End If
                        End With
                        
                        
                        ext:
                            
                            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
                            
                            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
                        
                        
                        rng.Select
                        
                        ending:
                        my_undo.EndCustomRecord
                        
                        Application.ScreenUpdating = True
                        
                        End Sub
                        
                        
                        תגובה 1 תגובה אחרונה
                        3
                        • ד דאנציג התייחס לנושא זה
                        • מ מנותק
                          מ מנותק
                          מניין
                          כתב נערך לאחרונה על ידי מניין
                          #179

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

                          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 תגובה 1 תגובה אחרונה
                          5
                          • מ מניין התייחס לנושא זה
                          • מ מנותק
                            מ מנותק
                            מניין
                            כתב נערך לאחרונה על ידי מניין
                            #180

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

                            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. ועוד שיפורים

                            menajemmendelM ש 3 תגובות תגובה אחרונה
                            3
                            • מ מניין

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

                              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. ועוד שיפורים

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

                              @מניין

                              Sub First_and_last_word_highlighting()
                              
                              Dim page As Range, lastWordNumber As Integer, pageCount As Integer
                              
                                  pageCount = ActiveDocument.ComputeStatistics(wdStatisticPages)
                                     For i = 1 To pageCount
                                          Selection.GoTo What:=wdGoToPage, Name:=i
                                          Set page = ActiveDocument.Bookmarks("\page").Range
                                          lastWordNumber = page.Words.Count
                                          page.Words(1).HighlightColorIndex = wdGreen
                                          page.Words(lastWordNumber).HighlightColorIndex = wdRed
                                      Next i
                                  MsgBox "המאקרו הסתיים בהצלחה!" & vbCr & vbCr & _
                                         "מאקרו מבית מאיר עיני חכמים-הבית לאוטומציה בוורד"
                              End Sub
                              
                              
                              מ U 2 תגובות תגובה אחרונה
                              3
                              • menajemmendelM menajemmendel

                                @מניין

                                Sub First_and_last_word_highlighting()
                                
                                Dim page As Range, lastWordNumber As Integer, pageCount As Integer
                                
                                    pageCount = ActiveDocument.ComputeStatistics(wdStatisticPages)
                                       For i = 1 To pageCount
                                            Selection.GoTo What:=wdGoToPage, Name:=i
                                            Set page = ActiveDocument.Bookmarks("\page").Range
                                            lastWordNumber = page.Words.Count
                                            page.Words(1).HighlightColorIndex = wdGreen
                                            page.Words(lastWordNumber).HighlightColorIndex = wdRed
                                        Next i
                                    MsgBox "המאקרו הסתיים בהצלחה!" & vbCr & vbCr & _
                                           "מאקרו מבית מאיר עיני חכמים-הבית לאוטומציה בוורד"
                                End Sub
                                
                                
                                מ מנותק
                                מ מנותק
                                מניין
                                כתב נערך לאחרונה על ידי
                                #182
                                פוסט זה נמחק!
                                תגובה 1 תגובה אחרונה
                                0
                                • menajemmendelM menajemmendel

                                  @מניין

                                  Sub First_and_last_word_highlighting()
                                  
                                  Dim page As Range, lastWordNumber As Integer, pageCount As Integer
                                  
                                      pageCount = ActiveDocument.ComputeStatistics(wdStatisticPages)
                                         For i = 1 To pageCount
                                              Selection.GoTo What:=wdGoToPage, Name:=i
                                              Set page = ActiveDocument.Bookmarks("\page").Range
                                              lastWordNumber = page.Words.Count
                                              page.Words(1).HighlightColorIndex = wdGreen
                                              page.Words(lastWordNumber).HighlightColorIndex = wdRed
                                          Next i
                                      MsgBox "המאקרו הסתיים בהצלחה!" & vbCr & vbCr & _
                                             "מאקרו מבית מאיר עיני חכמים-הבית לאוטומציה בוורד"
                                  End Sub
                                  
                                  
                                  U מנותק
                                  U מנותק
                                  u88
                                  כתב נערך לאחרונה על ידי
                                  #183

                                  @menajemmendel למה זה?

                                  menajemmendelM תגובה 1 תגובה אחרונה
                                  0
                                  • א מנותק
                                    א מנותק
                                    א. ד. ג.
                                    כתב נערך לאחרונה על ידי
                                    #184

                                    https://mitmachim.top/topic/78070/מדריך-אפלקציית-הגרלות-למחשב-באמצעות-פקודות-מאקרו-בוורד?_=1735114384700

                                    תגובה 1 תגובה אחרונה
                                    0
                                    • U u88

                                      @menajemmendel למה זה?

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

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

                                      @menajemmendel למה זה?

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

                                      menajemmendelM מ 2 תגובות תגובה אחרונה
                                      0
                                      • menajemmendelM menajemmendel התייחס לנושא זה
                                      • menajemmendelM menajemmendel

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

                                        @menajemmendel למה זה?

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

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

                                        📜 המאקרו המהפכני שכולם חיכו לו - חובה בכל מחשב! 📜

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

                                        🔍 הכירו את המאקרו
                                        מאקרו חדשני שמאפשר לספור כמה פעמים מופיעות אותיות מסוימות במסמך וורד! כן, שמעתם נכון!
                                        הכלי הזה יאפשר לכם:
                                        1️⃣ לגלות באילו אותיות אתם משתמשים הכי הרבה – אולי תגלו שאותיות כמו "צ" ו-"ף" זוכות להזנחה חמורה!
                                        2️⃣ להבין לעומק את סגנון הכתיבה שלכם – מה זה אומר עליכם אם האות "ת" מופיעה פי שניים מהאות "א"? (התשובה: הרבה).
                                        3️⃣ להרגיש מתוחכמים יותר מכל החברים שלכם, כי יש לכם מאקרו של מיספור אותיות וזה בדיוק מה שחסר להם בחיים שלהם.

                                        🤔 למי זה מתאים?

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

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

                                        👑 אז למה אתם מחכים?
                                        לחצו עכשיו על הקוד וצאו למסע שאפילו אילון מאסק עוד לא העז לחלום עליו!

                                        Sub arraySample()
                                        Dim otiot(1 To 22) As String
                                        Dim otiotNumber(1 To 22) As Integer
                                        Dim olddoc As Document
                                        Dim newdoc As Document
                                        
                                        otiot(1) = "א"
                                        otiot(2) = "ב"
                                        otiot(3) = "ג"
                                        otiot(4) = "ד"
                                        otiot(5) = "ה"
                                        otiot(6) = "ו"
                                        otiot(7) = "ז"
                                        otiot(8) = "ח"
                                        otiot(9) = "ט"
                                        otiot(10) = "י"
                                        otiot(11) = "כ"
                                        otiot(12) = "ל"
                                        otiot(13) = "מ"
                                        otiot(14) = "נ"
                                        otiot(15) = "ס"
                                        otiot(16) = "ע"
                                        otiot(17) = "פ"
                                        otiot(18) = "צ"
                                        otiot(19) = "ק"
                                        otiot(20) = "ר"
                                        otiot(21) = "ש"
                                        otiot(22) = "ת"
                                        
                                        Set olddoc = ActiveDocument
                                        Set newdoc = Documents.Add
                                        
                                        For i = LBound(otiot) To UBound(otiot)
                                            otiotNumber(i) = Len(olddoc.Range) - Len(Replace(olddoc.Range, otiot(i), ""))
                                            newdoc.Range.InsertAfter otiot(i) & " מופיע " & otiotNumber(i) & " מספר פעמים" & vbCr
                                        Next i
                                        
                                        newdoc.Activate
                                        
                                        End Sub
                                        
                                        צ תגובה 1 תגובה אחרונה
                                        1
                                        • menajemmendelM menajemmendel

                                          📜 המאקרו המהפכני שכולם חיכו לו - חובה בכל מחשב! 📜

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

                                          🔍 הכירו את המאקרו
                                          מאקרו חדשני שמאפשר לספור כמה פעמים מופיעות אותיות מסוימות במסמך וורד! כן, שמעתם נכון!
                                          הכלי הזה יאפשר לכם:
                                          1️⃣ לגלות באילו אותיות אתם משתמשים הכי הרבה – אולי תגלו שאותיות כמו "צ" ו-"ף" זוכות להזנחה חמורה!
                                          2️⃣ להבין לעומק את סגנון הכתיבה שלכם – מה זה אומר עליכם אם האות "ת" מופיעה פי שניים מהאות "א"? (התשובה: הרבה).
                                          3️⃣ להרגיש מתוחכמים יותר מכל החברים שלכם, כי יש לכם מאקרו של מיספור אותיות וזה בדיוק מה שחסר להם בחיים שלהם.

                                          🤔 למי זה מתאים?

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

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

                                          👑 אז למה אתם מחכים?
                                          לחצו עכשיו על הקוד וצאו למסע שאפילו אילון מאסק עוד לא העז לחלום עליו!

                                          Sub arraySample()
                                          Dim otiot(1 To 22) As String
                                          Dim otiotNumber(1 To 22) As Integer
                                          Dim olddoc As Document
                                          Dim newdoc As Document
                                          
                                          otiot(1) = "א"
                                          otiot(2) = "ב"
                                          otiot(3) = "ג"
                                          otiot(4) = "ד"
                                          otiot(5) = "ה"
                                          otiot(6) = "ו"
                                          otiot(7) = "ז"
                                          otiot(8) = "ח"
                                          otiot(9) = "ט"
                                          otiot(10) = "י"
                                          otiot(11) = "כ"
                                          otiot(12) = "ל"
                                          otiot(13) = "מ"
                                          otiot(14) = "נ"
                                          otiot(15) = "ס"
                                          otiot(16) = "ע"
                                          otiot(17) = "פ"
                                          otiot(18) = "צ"
                                          otiot(19) = "ק"
                                          otiot(20) = "ר"
                                          otiot(21) = "ש"
                                          otiot(22) = "ת"
                                          
                                          Set olddoc = ActiveDocument
                                          Set newdoc = Documents.Add
                                          
                                          For i = LBound(otiot) To UBound(otiot)
                                              otiotNumber(i) = Len(olddoc.Range) - Len(Replace(olddoc.Range, otiot(i), ""))
                                              newdoc.Range.InsertAfter otiot(i) & " מופיע " & otiotNumber(i) & " מספר פעמים" & vbCr
                                          Next i
                                          
                                          newdoc.Activate
                                          
                                          End Sub
                                          
                                          צ מנותק
                                          צ מנותק
                                          צדיק וטוב לו 0
                                          כתב נערך לאחרונה על ידי
                                          #187

                                          @menajemmendel הוא עובד גם אותיות סופיות?
                                          (אגב, מה הבעיה לספור דרך החיפוש פשוט של וורד?)

                                          U menajemmendelM 2 תגובות תגובה אחרונה
                                          1

                                          • התחברות

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

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