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

    @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
                          • חוקי הפורום
                          • פופולרי
                          • לא נפתר
                          • משתמשים
                          • חיפוש גוגל בפורום
                          • צור קשר