וורד - דחוף! מי יודע איך מוצאים פסקה בת שורה אחת בוורד
אם למישהו יש מאקרו להעתיק לכאן אשמח
www.prog.co.il
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
@מהודר! מקווה שעזרתי.וורד - דחוף! מי יודע איך מוצאים פסקה בת שורה אחת בוורד
אם למישהו יש מאקרו להעתיק לכאן אשמחwww.prog.co.il
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
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
בבקשה, הנה המאקרו:
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 בשורה האחרונה.תודה אבל הוא נתקע אחרי כמה שניות, תנסו
נראה שבסוף ממש.איפה? אני לא מצליח?
קוד: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
על איזה קובץ?מוזר מאד, אצלי עובד מצויין. איזה גירסה של וורד יש לך?
לוח לימודים
מסלולי לימוד שאפשר לההצטרף
אליהם ממש עכשיו:
2.04
כ"ג אדר ב'
השקה חגיגית
חדש בפרוג
קורס חדשנות AI ובינה מלאכותית
14 שיעורים מפוצצים תוכן על כלי הAI השונים ליצירת תמונות וויז'ואל, עריכת וידאו ומושן, כתיבה ורעיונות, אפיון ועיצוב אתרים ועוד המון!
ההרשמה נפתחה!
20.03
י' אדר ב'
פתיחת מסלול
עיצוב ואדריכלות פנים
מלגות גבוהות!
26.03
טז' אדר ב'
פתיחת מסלול
מאסטר בשיווק דיגיטלי
מלגות גבוהות!
8.05
ל' ניסן
פתיחת מסלול
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
מלגות גבוהות!
9.05
א' אייר
ירושלמי?
יש לנו מלגה מטורפת עבורך! קורס במימון כמעט מלא!!
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
ההרשמה בעיצומה
28.05
כ' אייר
פתיחת מסלול מורחב:
פיתוח ובניית אתרים
מלגות גבוהות!
תהילים פרק קכט
א שִׁיר הַמַּעֲלוֹת רַבַּת צְרָרוּנִי מִנְּעוּרַי יֹאמַר נָא יִשְׂרָאֵל:ב רַבַּת צְרָרוּנִי מִנְּעוּרָי גַּם לֹא יָכְלוּ לִי:ג עַל גַּבִּי חָרְשׁוּ חֹרְשִׁים הֶאֱרִיכוּ (למענותם) לְמַעֲנִיתָם:ד יְהוָה צַדִּיק קִצֵּץ עֲבוֹת רְשָׁעִים:ה יֵבֹשׁוּ וְיִסֹּגוּ אָחוֹר כֹּל שֹׂנְאֵי צִיּוֹן:ו יִהְיוּ כַּחֲצִיר גַּגּוֹת שֶׁקַּדְמַת שָׁלַף יָבֵשׁ:ז שֶׁלֹּא מִלֵּא כַפּוֹ קוֹצֵר וְחִצְנוֹ מְעַמֵּר:ח וְלֹא אָמְרוּ הָעֹבְרִים בִּרְכַּת יְהוָה אֲלֵיכֶם בֵּרַכְנוּ אֶתְכֶם בְּשֵׁם יְהוָה: