דילוג לתוכן
  • חוקי הפורום
  • פופולרי
  • לא נפתר
  • משתמשים
  • חיפוש גוגל בפורום
  • צור קשר
עיצובים
  • 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. VBA - excel
  6. עזרה הדדית - VBA excel
  7. שיתוף | יישור טורים מאקרו חדש!!!

שיתוף | יישור טורים מאקרו חדש!!!

מתוזמן נעוץ נעול הועבר עזרה הדדית - VBA excel
61 פוסטים 16 כותבים 2.7k צפיות 18 עוקבים
  • מהישן לחדש
  • מהחדש לישן
  • הכי הרבה הצבעות
תגובה
  • תגובה כנושא
התחברו כדי לפרסם תגובה
נושא זה נמחק. רק משתמשים עם הרשאות מתאימות יוכלו לצפות בו.
  • P pcinfogmach

    @ישראל-כהן
    יש לך שני טורים במסמך?

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

    @pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:

    @ישראל-כהן
    יש לך שני טורים במסמך?

    כן

    P תגובה 1 תגובה אחרונה
    0
    • י ישראל כהן

      @pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:

      @ישראל-כהן
      יש לך שני טורים במסמך?

      כן

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

      @ישראל-כהן
      תנסה את התוסף שלי
      https://mitmachim.top/post/626904

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

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

        @ישראל-כהן
        תנסה את התוסף שלי
        https://mitmachim.top/post/626904

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

        @pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:

        @ישראל-כהן
        תנסה את התוסף שלי
        https://mitmachim.top/post/626904

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

        ניסיתי את כל מה שכתבת פה, https://mitmachim.top/topic/63879/להורדה-תוסף-לוורד-תוסף-עיצוב-תורני/2?_=1711318572441
        וזה עדיין לא עזר.
        מה עוד יכול להיות?

        P 2 תגובות תגובה אחרונה
        0
        • י ישראל כהן

          @pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:

          @ישראל-כהן
          תנסה את התוסף שלי
          https://mitmachim.top/post/626904

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

          ניסיתי את כל מה שכתבת פה, https://mitmachim.top/topic/63879/להורדה-תוסף-לוורד-תוסף-עיצוב-תורני/2?_=1711318572441
          וזה עדיין לא עזר.
          מה עוד יכול להיות?

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

          @ישראל-כהן
          לא יודע סליחה.
          אתה יכול הלעתיק משם את המאקרו ולהשתמש בו

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

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

            @ישראל-כהן
            לא יודע סליחה.
            אתה יכול הלעתיק משם את המאקרו ולהשתמש בו

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

            @pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:

            @ישראל-כהן
            לא יודע סליחה.
            אתה יכול הלעתיק משם את המאקרו ולהשתמש בו

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

            תגובה 1 תגובה אחרונה
            0
            • י ישראל כהן

              @רפרם-ב-ר-פפא
              התקנתי את המאקרו, וכשאני לוחץ על 'הפעל', מופיעה לי תקלה זו
              048df7f0-8f4e-4c4d-997f-ab358ff13264-image.png
              מה עשיתי לא טוב?
              תודה רבה רבה!

              ר מנותק
              ר מנותק
              רפרם ב"ר פפא
              כתב ב נערך לאחרונה על ידי
              #54

              @ישראל-כהן
              יש לך תיבת טקסט או מסגרת במסמך?

              י תגובה 1 תגובה אחרונה
              1
              • י ישראל כהן

                @pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:

                @ישראל-כהן
                תנסה את התוסף שלי
                https://mitmachim.top/post/626904

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

                ניסיתי את כל מה שכתבת פה, https://mitmachim.top/topic/63879/להורדה-תוסף-לוורד-תוסף-עיצוב-תורני/2?_=1711318572441
                וזה עדיין לא עזר.
                מה עוד יכול להיות?

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

                @ישראל-כהן
                עשית את זה?

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

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

                תגובה 1 תגובה אחרונה
                1
                • ר רפרם ב"ר פפא

                  @ישראל-כהן
                  יש לך תיבת טקסט או מסגרת במסמך?

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

                  @רפרם-ב-ר-פפא כתב בשיתוף | יישור טורים מאקרו חדש!!!:

                  @ישראל-כהן
                  יש לך תיבת טקסט או מסגרת במסמך?

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

                  P תגובה 1 תגובה אחרונה
                  0
                  • י ישראל כהן

                    @רפרם-ב-ר-פפא כתב בשיתוף | יישור טורים מאקרו חדש!!!:

                    @ישראל-כהן
                    יש לך תיבת טקסט או מסגרת במסמך?

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

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

                    @ישראל-כהן
                    אל תעשה מסגרת יש שיטות אחרות לעשות מילה ראשונה תלויה

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

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

                      @ישראל-כהן
                      אל תעשה מסגרת יש שיטות אחרות לעשות מילה ראשונה תלויה

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

                      @pcinfogmach כתב בשיתוף | יישור טורים מאקרו חדש!!!:

                      @ישראל-כהן
                      אל תעשה מסגרת יש שיטות אחרות לעשות מילה ראשונה תלויה

                      והן?

                      תגובה 1 תגובה אחרונה
                      0
                      • ר רפרם ב"ר פפא

                        חדש! מאקרו ליישור טורים
                        והפעם בקוד פתוח לצורך שיפור המאקרו ע"י כל החברים
                        להערות הארות נא לדווח
                        וכן כל דבר שיכול לשפר את הפעולה
                        מצורף קובץ תבנית וורד אם אפשרות ליישור עמוד 1 או יישור כל המסמך
                        עדכון אדר תשפ"ג
                        יישור טורים 3.dotm

                        וכן הקוד שכתבתי

                        Public Sub יישור_טורים()
                        'בודק אם יש שני טורים
                        If Selection.PageSetup.TextColumns.Count <> 2 Then MsgBox ("לא נמצאו 2 טורים"): Exit Sub
                        'עדכון מסך שקר
                        Application.ScreenUpdating = False
                        Dim WRange, Endcol2, Startcol1, Rcol1, Rcol2 As Range
                        Dim NumLines, WPage, Pcol1, Pcol2, APcol, PPS, a, i, B, C, P, S, col1, col2, Acol, Ignore As Double
                        
                        'שומר תחילת שורה של מיקום נוכחי
                        Selection.HomeKey Unit:=wdLine
                        Set My = Selection.Range
                        'תחילת עמוד
                        Set WRange = ActiveDocument.Bookmarks("\page").Range
                        WRange.SetRange Start:=WRange.Start, End:=WRange.Start + 1
                        WRange.Select
                        Set Startpage = Selection.Range
                        WRange.SetRange Start:=Startpage.End, End:=My.End
                        'סופר שורות
                        WRange.Select
                        SLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                        'חוזר ומפעיל לולאת בדיקה שאין כותרת'
                        My.Select
                        'Startcol1 מגדיר תחילת טור 1
                        For S = 1 To SLines - 1
                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1, Name:=""
                             If Selection.PageSetup.TextColumns.Count <> 2 Then
                                Exit For
                            Else
                                Set Startcol1 = Selection.Range
                            End If
                        Next
                        'סוף עמוד
                        Set WRange = ActiveDocument.Bookmarks("\page").Range
                        WRange.SetRange Start:=WRange.End - 1, End:=WRange.End
                        WRange.Select
                        Set Endpage = Selection.Range
                        WRange.SetRange Start:=My.Start, End:=Endpage.End
                        'סופר שורות
                        WRange.Select
                        ELines = Selection.Range.ComputeStatistics(wdStatisticLines)
                        My.Select
                        'Endcol2 מגדיר סוף טור 2
                        For S = 1 To ELines - 1
                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                             If Selection.PageSetup.TextColumns.Count <> 2 Then
                                Exit For
                            Else
                                Set Endcol2 = Selection.Range
                            End If
                        Next
                        
                        'מספר שורות כולל שני טורים
                        Set WRange = Selection.Range
                        WRange.SetRange Start:=Startcol1.End, End:=Endcol2.End
                        WRange.Select
                        NumLines = Selection.Range.ComputeStatistics(wdStatisticLines)
                        ' - col2 מגדיר גובה טור 2
                        Endcol2.Select
                        col2 = Endcol2.Information(wdVerticalPositionRelativeToPage)
                        Selection.EndKey Unit:=wdLine
                        Set Endcol2 = Selection.Range
                        
                        
                        '  col1מגדיר גובה טור -1
                        'Endcol1- סוף טור 1
                        'Startcol2- תחילת טור2
                        
                        Startcol1.Select
                        For i = 1 To NumLines
                            Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
                           If col1 > Selection.Information(wdVerticalPositionRelativeToPage) Then
                          Set Startcol2 = Selection.Range
                                Exit For
                            Else
                                col1 = Selection.Information(wdVerticalPositionRelativeToPage)
                               Set Endcol1 = Selection.Range
                            End If
                            
                        Next
                        'סוף טור 1 = סוף שורה
                        Endcol1.Select
                        Selection.EndKey Unit:=wdLine
                        Set Endcol1 = Selection.Range
                        
                        'Acol מגדיר הפרש בין טורים
                                If col1 > col2 Then Acol = col1 - col2
                                If col1 < col2 Then Acol = col2 - col1
                            
                            'בודק אם טורים ישרים
                        
                          If Acol < 0.05 Then
                            MsgBox "טורים ישרים"
                         'אם רווח גדול מידי מוסיף בסוף פסקה בטור 1
                           ElseIf Acol > 50 Then
                           Endcol2.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
                            
                           ElseIf Acol > 0.05 Then
                            
                        'Pcol1 - מספר פסקאות טור 1
                            WRange.SetRange Start:=Startcol1.Start, End:=Endcol1.End - 2
                            WRange.Select
                           Set Rcol1 = Selection.Range
                             Rcol1.Select
                          Pcol1 = (Rcol1.ComputeStatistics(wdStatisticParagraphs))
                        
                        'Pcol2 - מספר פסקאות טור 2
                            WRange.SetRange Start:=Startcol2.Start, End:=Endcol2.End - 2
                            WRange.Select
                            Set Rcol2 = Selection.Range
                             Rcol2.Select
                           Pcol2 = (Rcol2.ComputeStatistics(wdStatisticParagraphs))
                        'טור מרובה פסקאות
                        If Pcol1 > Pcol2 Then
                        'עורך טור1
                          
                        ' PPS - מחלק הפרש בין פסקאות
                            PPS = Acol / Pcol1
                         'עבור לשורה ראשונה בטור
                          Startcol1.Select
                          'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                            For P = 1 To Pcol1
                        'אם
                         If col1 > col2 Then
                        'מקטין רווח אחרי פסקה
                              With Selection
                               For B = 1 To .Paragraphs.Count
                              .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                               Next B
                              End With
                          'עבור לפסקה הבאה
                             Selection.MoveDown wdParagraph, 1
                        ElseIf col1 < col2 Then
                        'מוסיף רווח אחרי פסקה
                             With Selection
                            For B = 1 To .Paragraphs.Count
                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                            Next B
                             End With
                          'עבור לפסקה הבאה
                             Selection.MoveDown wdParagraph, 1
                            End If
                            Next
                            
                        Else
                         'עורך טור 2
                        
                        'מחלק הפרש בין פסקאות
                            PPS = Acol / Pcol2
                            'עבור לשורה ראשונה בטור 2
                                Startcol2.Select
                          'מפעיל פקודת תיקון בלולאה *מס' פסקאות
                            For P = 1 To Pcol2
                        
                            If col1 > col2 Then
                        'מוסיף רווח אחרי פסקה
                             With Selection
                            For B = 1 To .Paragraphs.Count
                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter + PPS
                            Next B
                          End With
                          'עבור לפסקה הבאה
                          Selection.MoveDown wdParagraph, 1
                           ElseIf col1 < col2 Then
                        'מקטין רווח אחרי פסקה
                          With Selection
                            For B = 1 To .Paragraphs.Count
                            .Paragraphs(B).Format.SpaceAfter = .Paragraphs(B).Format.SpaceAfter - PPS
                            Next B
                          End With
                          'עבור לפסקה הבאה
                          Selection.MoveDown wdParagraph, 1
                           
                           End If
                            Next
                           End If
                           End If
                           Application.ScreenUpdating = True
                        End Sub
                        
                        מ מנותק
                        מ מנותק
                        משה גל
                        כתב נערך לאחרונה על ידי
                        #59

                        @רפרם-ב-ר-פפא יישר כח עצום!
                        להדיוטות כמוני: איך אני מכניס את פקודת המאקרו שתהיה בוורד תמיד?
                        לא הצלחתי ליישר טורים לפי האמור רק כשהעתקתי קובץ קיים לתוך קובץ הוורד של המאקרו...
                        אני מבין שזה לא אמור להיות כך...

                        שבוע טוב והמון שכוייח

                        menajemmendelM תגובה 1 תגובה אחרונה
                        0
                        • מ משה גל

                          @רפרם-ב-ר-פפא יישר כח עצום!
                          להדיוטות כמוני: איך אני מכניס את פקודת המאקרו שתהיה בוורד תמיד?
                          לא הצלחתי ליישר טורים לפי האמור רק כשהעתקתי קובץ קיים לתוך קובץ הוורד של המאקרו...
                          אני מבין שזה לא אמור להיות כך...

                          שבוע טוב והמון שכוייח

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

                          @משה-גל
                          תתקין את התוסף וורד תורני, יש את הפקודה הזאת ועוד הרבה
                          https://mitmachim.top/topic/63879/להורדה-תוסף-לוורד-תוסף-עיצוב-תורני

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

                            אין לי אפשרות ללייק...
                            תזכה לפול ישועות!

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

                            • התחברות

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

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