מישהו יכול לעזור? תודה

[מהודר!]

וורד - דחוף! מי יודע איך מוצאים פסקה בת שורה אחת בוורד

אם למישהו יש מאקרו להעתיק לכאן אשמח

www.prog.co.il

 

[sivan22]

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

Sub Macro2()
'
' Macro2 Macro
'
'
Dim wdPage As Page, wdRct As Rectangle, wdRng As Range, wdLine As Line
For Each wdPage In ActiveDocument.ActiveWindow.Panes(1).Pages
   For Each wdRct In wdPage.Rectangles
      If wdRct.RectangleType = wdTextRectangle Then
          If wdRct.Lines.Count = 1 Then
            'כאן ניתן להכניס כל קוד שתרצה - במקרה הזה מדגיש בצהוב
             wdRct.Range.HighlightColorIndex = wdYellow
          End If
      End If
   Next
Next
    
End Sub

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

 

[sivan22]

וורד - דחוף! מי יודע איך מוצאים פסקה בת שורה אחת בוורד

אם למישהו יש מאקרו להעתיק לכאן אשמח

www.prog.co.il

@מהודר! מקווה שעזרתי.

 

[sivan22]

והנה מאקרו שפשוט מוצא את הפיסקה הבאה בעלת שורה אחת:

Sub Macro2()
'
' Macro2 Macro
'
'
Dim wdPage As Page, wdRct As Rectangle, wdRng As Range, wdLine As Line
For Each wdPage In ActiveDocument.ActiveWindow.Panes(1).Pages
   For Each wdRct In wdPage.Rectangles
      If wdRct.RectangleType = wdTextRectangle Then
          If wdRct.Lines.Count = 1 And wdRct.Range.Start > Selection.Start Then
             wdRct.Range.Select
             Exit Sub
          End If
      End If
   Next
Next
    
End Sub

 

[מהודר!]

המתחיל במצוה אומרים לו גמור...

אשמח למאקרו שימצא רצף של פיסקאות מודגשות בנות שורה אחת, הראשון עם סימון שיחיל עליו את סגנון כותרות 1, השני בלי סימון כותרת 2 השלישי 3 הרביעי 4.


תודה

 

[מהודר!]

מי יכול להוסיף הגבלה בחיפוש של המאקרו הזה, שיגביל את החיפוש של השורה למס' תווים מסויימים, זה מאקרו שמריץ כותרות ברמות שונות.

Sub החלת_סגנון()
Dim B, I As Double
 
ActiveDocument.Paragraphs(1).Range.Select
For P = 1 To ActiveDocument.Paragraphs.Count
                   For B = 1 To Selection.Paragraphs.Count
                    Selection.Paragraphs(B).Range.Select
                    Next B
If Selection.PageSetup.TextColumns.Count = 1 And Selection.Range.Bold = True Then
I = I + 1
Selection.Style = ActiveDocument.Styles("כותרת " & I)
Selection.MoveDown wdParagraph, 1
Else
Selection.MoveDown wdParagraph, 1
I = 0
End If
Next P
End Sub

 

[מהודר!]

?

 

[מהודר!]

?

 

[sivan22]

?

בבקשה, הנה המאקרו:

Sub חדשהחלת_סגנון()

Dim wdPage As Page, wdRct As Rectangle, wdRng As Range, wdLine As Line, I As Double
I = 0
For Each wdPage In ActiveDocument.ActiveWindow.Panes(1).Pages
   For Each wdRct In wdPage.Rectangles
      If wdRct.RectangleType = wdTextRectangle Then
          If wdRct.Lines.Count = 1 And wdRct.Range.Start > Selection.Start Then
             wdRct.Range.Select
             If Selection.Range.Bold = True And Selection.Range.Characters.Count < 20 Then
                I = I + 1
                Selection.Style = ActiveDocument.Styles("כותרת " & I)
             Else
                I = 0
             End If
          End If
      End If
   Next
Next

דרך אגב המאקרו שאתה הבאת שגוי, הוא בוחר גם פסקאות עם יותר משורה אחת.

 

[מהודר!]

תודה אבל הוא נתקע אחרי כמה שניות, תנסו

 

[מהודר!]

@sivan22

 

[sivan22]

תודה אבל הוא נתקע אחרי כמה שניות, תנסו

סליחה, חסרות המילים End sub בשורה האחרונה.

 

[מהודר!]

איפה? אני לא מצליח?

 

[רוב]

איפה? אני לא מצליח?

נראה שבסוף ממש.
השורה הראשונה היא תחילת ה- Sub ואין לו סיום.

Sub חדשהחלת_סגנון()

    Dim wdPage As Page, wdRct As Rectangle, wdRng As Range, wdLine As Line, I As Double
    I = 0
    For Each wdPage In ActiveDocument.ActiveWindow.Panes(1).Pages
       For Each wdRct In wdPage.Rectangles
          If wdRct.RectangleType = wdTextRectangle Then
              If wdRct.Lines.Count = 1 And wdRct.Range.Start > Selection.Start Then
                 wdRct.Range.Select
                 If Selection.Range.Bold = True And Selection.Range.Characters.Count < 20 Then
                    I = I + 1
                    Selection.Style = ActiveDocument.Styles("כותרת " & I)
                 Else
                    I = 0
                 End If
              End If
          End If
       Next
    Next
End Sub

 

[מהודר!]

כשאני מריץ את המאקרו הוא מראה מה תוקע את המאקרו:

 

[sivan22]

מוזר מאד, אצלי עובד מצויין. איזה גירסה של וורד יש לך?

 

[מהודר!]

מוזר מאד, אצלי עובד מצויין. איזה גירסה של וורד יש לך?

על איזה קובץ?
אני יכול לשלוח לך את הקובץ ותראה בעצמך

365

 

[sivan22]

תשלח את הקובץ ואנסה. תעלה אותו לשיחה פרטית.

 

[מהודר!]

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