שיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות
-
@מניין כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:
@pcinfogmach לגבי המאקרו הזה [תבנית מחיקת פסקאות ריקות ורווח לפני פסקא], יש לשים לב, שבתחילת פסקא או אחר מעבר מקטע זה לא מוחק פסקאות ריקות, בגלל שהמאקרו מחפש סוף פסקא כפול, ולא תחילת פיסקא כפול, אשמח מאוד לקבל רעיונות ממי שיש לו פיתרון לזה.
@דאנציג @pcinfogmach הוספתי בקובץ פיתרון למחיקת פסקאות ריקות לאחר מעברים תבנית-מחיקת-פסקאות-ריקות-ורווח-לפני-פסקא.dotm .
@דאנציג אם אתה יכול תחליף את הקובץ שעשית כאן עם החדש שהכנסתי כאן. -
שאלה לגבי מאקרו עיצוב ספרי קודש
- לגבי המאקרו שמעצב את המילה הראשונה - כרגע המאקרו לא מעצב את המילה הראשונה בפיסקאות עם שורה אחת האם עדיף שגם יעצב פיסקאות כאלו?
- כמו"כ לגבי המאקרו להוספת חלון - כרגע עושה גם בפיסקה עם שני שורות האם עדיף שיעקוף על פיסקאות כאלו?
- כמו"כ לגבי המאקרו למרכוז שורה אחרונה כרגע עושה גם בפיסקה עם שני שורות האם עדיף שיעקוף על פיסקאות כאלו?
-
@pcinfogmach כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:
שאלה לגבי מאקרו עיצוב ספרי קודש
- לגבי המאקרו שמעצב את המילה הראשונה - כרגע המאקרו לא מעצב את המילה הראשונה בפיסקאות עם שורה אחת האם עדיף שגם יעצב פיסקאות כאלו?
- כמו"כ לגבי המאקרו להוספת חלון - כרגע עושה גם בפיסקה עם שני שורות האם עדיף שיעקוף על פיסקאות כאלו?
- כמו"כ לגבי המאקרו למרכוז שורה אחרונה כרגע עושה גם בפיסקה עם שני שורות האם עדיף שיעקוף על פיסקאות כאלו?
לענ"ד
לעשות מאקרו הרגיל - שכולל הכל [עיצוב בשורה 1, חלון בשנים, ומרכוז בשנים]
ו3 מאקרוים שמבטלים אותו.
[מאקרו להסרת חלון מפיסקאות בעלות שני שורות, וכו'.] -
@pcinfogmach כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:
שאלה לגבי מאקרו עיצוב ספרי קודש
גם אני מצטרף ל @צדיק-וטוב-לו-0
-
@דאנציג כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:
@pcinfogmach כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:
שאלה לגבי מאקרו עיצוב ספרי קודש
גם אני מצטרף ל @צדיק-וטוב-לו-0
גם אני מצטרף, אבל צריך שידלג על פסקאות ממורכזות, שבדרך כלל אלו הם כותרות, ודו"ק.
-
@pcinfogmach כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:
שאלה לגבי מאקרו עיצוב ספרי קודש
- כמו"כ לגבי המאקרו להוספת חלון - כרגע עושה גם בפיסקה עם שני שורות האם עדיף שיעקוף על פיסקאות כאלו?
- כמו"כ לגבי המאקרו למרכוז שורה אחרונה כרגע עושה גם בפיסקה עם שני שורות האם עדיף שיעקוף על פיסקאות כאלו?
ראיתי בסידור של עוז והדר שהם עשו חלון גם בפסקה עם 2 שורות והשורה השנייה לא הייתה ממורכזת . החידוש שם שגם ב 3 שורות השורה השלישית לא הייתה ממורכזת אלא התחילה מהמקום שבו נגמר החלון של השורה השניה
זה נראה כך יפה מאד. -
@mfmf
@mfmf כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:ראיתי בסידור של עוז והדר שהם עשו חלון גם בפסקה עם 2 שורות והשורה השנייה לא הייתה ממורכזת . החידוש שם שגם ב 3 שורות השורה השלישית לא הייתה ממורכזת אלא התחילה מהמקום שבו נגמר החלון של השורה השניה
יפה
אמנם נראה לי שסידורים מעוצבים אחרת משאר ספרים תפתח כל סידור לברכות השחר ותראה מה אני מתכווין.
למעשה האם צריך ליצור גם את זה במאקרו וכמה זה דחוף? (כמה כבר מעצבים סידור עם המאקרו?) -
תגובה למה שכתבת כאן
כמדומני שהוא מוגבל בעברית קצת, לא?
[מהאות שצג הוא משתגע]זה בעיה בכל סוגי המספור של וורד בעברית, ונקרא באג שצג, אם אתה עובר את השצ"ג צריך להשתמש עם מספרים ולעשות המרה לאותיות.
-
@pcinfogmach כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:
@mfmf
@mfmf כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:ראיתי בסידור של עוז והדר שהם עשו חלון גם בפסקה עם 2 שורות והשורה השנייה לא הייתה ממורכזת . החידוש שם שגם ב 3 שורות השורה השלישית לא הייתה ממורכזת אלא התחילה מהמקום שבו נגמר החלון של השורה השניה
יפה
אמנם נראה לי שסידורים מעוצבים אחרת משאר ספרים תפתח כל סידור לברכות השחר ותראה מה אני מתכווין.
למעשה האם צריך ליצור גם את זה במאקרו וכמה זה דחוף? (כמה כבר מעצבים סידור עם המאקרו?)יצרת את זה? ראיתי את זה בתוסף בגירסה של האדם החושב.
אתה יכול לתת לי את הקוד? -
@mfmf
הנה הקוד עבור הוספת חלון במסמך
הקוד בבסיס הוא של @NykUser אני רק שיפצתי אותו
אשמח מאוד אם תוכל לבדוק לי שהכל עובד כשורה
שם המאקרו להוספת חלון כפול הוא: DoubleWindowUnderFirstWordSelection
כמו"כ נוסף כאן אפשרות להרחיב את החלון לכמה מילים לפי בחירה במאקרו WindowUnderManyWordsSelectionOption Explicit Sub WindowUnderFirstWordSelection() ' 'הוספת חלון מתחת למילה הראשונה בפיסקאות שנבחרו 'מאת ניקיוזר ' 'הצהרת המשתנים Dim myrange As Range Dim i As Integer Dim para As Range Dim char As Range Dim replacements As Boolean 'בחירת טווח הלולאה Set myrange = Selection.Range myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting myrange.Find.Execute FindText:="^f", ReplaceWith:="^&%?!#...", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll myrange.Find.Execute FindText:="%?!#... ", ReplaceWith:=ChrW(8194), Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll myrange.Find.Execute FindText:="%?!#...", ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll 'מניעת בעיות כלליות myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With myrange.Find .Execute FindText:=Chr(11) & vbTab, ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll If .Found = True Then replacements = True End If .Execute FindText:=Chr(11) & ChrW(8197), ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll End With 'תחילת הלולאה For i = 1 To myrange.Paragraphs.count Set para = myrange.Paragraphs(i).Range 'טווח הפיסקאות ' החרגות If para.ComputeStatistics(wdStatisticLines) <> 1 Then If para.ParagraphFormat.Alignment <> wdAlignParagraphCenter Then If Not para.Style Like "כותרת*" Then If Not para.Style Like "Heading*" Then 'If Not para.ComputeStatistics(wdStatisticLines) <> 2 Then replacements = False 'שלב א העמדת הסמן אחרי הרווח הראשון בפיסקה With para .Collapse: .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd .Select End With 'שלב ב הוספת החלון With Selection .EndKey Unit:=wdLine If .Text = Chr(13) Then GoTo nxt If .Text = Chr(11) Then .Delete Unit:=wdCharacter, count:=1 'מניעת בעיות .TypeText Text:=Chr(11) & ChrW(8197) Set char = Selection.Range .Previous.Font.Spacing = char.Information(wdHorizontalPositionRelativeToTextBoundary) - para.Information(wdHorizontalPositionRelativeToTextBoundary) End With 'המשך של מניעת בעיות כלליות If replacements = True Then With para .Collapse: .MoveUntil Chr(13): .MoveEnd: .Collapse Direction:=wdCollapseEnd .End = .End - 1 ' subtract 1 from the end position .Select End With Selection.HomeKey Unit:=wdLine 'מניעת בעיות With Selection If .Text = ChrW(8197) Then GoTo nxt If .Previous.Text = Chr(11) Then .Previous.Delete Unit:=wdCharacter, count:=1 End With 'הוספת טאב ידני Dim middlePosition As Double middlePosition = Selection.Sections(1).PageSetup.TextColumns(1).Width / 2 With Selection .ParagraphFormat.TabStops.ClearAll .ParagraphFormat.TabStops.Add Position:=middlePosition, Alignment:=wdAlignTabCenter End With Selection.TypeText Chr(11) & vbTab 'המשך של החרגות End If End If End If End If End If 'המשך הלולאה nxt: Next Application.ScreenRefresh End Sub Sub DoubleWindowUnderFirstWordSelection() ' 'הוספת חלון מתחת למילה הראשונה בפיסקאות שנבחרו 'מאת ניקיוזר ' 'הצהרת המשתנים Dim myrange As Range Dim i As Integer Dim para As Range Dim char As Range Dim replacements As Boolean Dim solveletters As VbMsgBoxResult 'בחירת טווח הלולאה Set myrange = Selection.Range myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting myrange.Find.Execute FindText:="^f", ReplaceWith:="^&%?!#...", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll myrange.Find.Execute FindText:="%?!#... ", ReplaceWith:=ChrW(8194), Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll myrange.Find.Execute FindText:="%?!#...", ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll 'תחילת הלולאה For i = 1 To myrange.Paragraphs.count Set para = myrange.Paragraphs(i).Range 'טווח הפיסקאות ' החרגות If Not para.ComputeStatistics(wdStatisticLines) <> 3 Then If para.ParagraphFormat.Alignment <> wdAlignParagraphCenter Then If Not para.Style Like "כותרת*" Then If Not para.Style Like "Heading*" Then 'מניעת בעיות כלליות Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With para.Find .Execute FindText:=Chr(11) & vbTab, ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll If .Found = True Then replacements = True End If .Execute FindText:=Chr(11) & ChrW(8197), ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll End With 'שלב א העמדת הסמן אחרי הרווח הראשון בפיסקה With para .Collapse: .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd If .Previous(count:=2) = Chr(93) Or .Previous(count:=2) = Chr(41) Then 'מניעת בעיות If solveletters = vbNo Then GoTo skp If solveletters = vbYes Then GoTo doit solveletters = MsgBox("ייתכן שהמילה הראשונה משמשת כסימון של סימנים. האם להרחיב את החלון עד מתחת למילה השנייה?", vbQuestion + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "מאקרו חלון מתחת למילה הראשונה") If solveletters = vbNo Then GoTo skp doit: If solveletters Then .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd End If 'עד כאן מניעת בעיות skp: .Select End With 'שלב ב הוספת החלון With Selection .EndKey Unit:=wdLine If .Text = Chr(11) Then .Delete Unit:=wdCharacter, count:=1 'מניעת בעיות .TypeText Text:=Chr(11) & ChrW(8197) Set char = Selection.Range .Previous.Font.Spacing = char.Information(wdHorizontalPositionRelativeToTextBoundary) - para.Information(wdHorizontalPositionRelativeToTextBoundary) End With 'מניעת יצירת חלון כפול בפסקה עם 4 שורות Dim rng4 As Range Dim para4 As Range Set rng4 = Selection.Range Set para4 = rng4.Paragraphs(1).Range If Not para4.ComputeStatistics(wdStatisticLines) <> 4 Then If replacements = True Then Call LastLine.CenterLastLineSelection replacements = False GoTo endr End If 'שלב ג הוספת חלון בשורה שלישית With Selection .EndKey Unit:=wdLine If .Text = Chr(11) Then .Delete Unit:=wdCharacter, count:=1 'מניעת בעיות .TypeText Text:=Chr(11) & ChrW(8197) Set char = Selection.Range .Previous.Font.Spacing = char.Information(wdHorizontalPositionRelativeToTextBoundary) - para.Information(wdHorizontalPositionRelativeToTextBoundary) End With 'מניעת יצירת פיסקה עם 4 שורות If Not para4.ComputeStatistics(wdStatisticLines) <> 4 Then Selection.Previous.Delete Unit:=wdCharacter, count:=2 If replacements = True Then Call LastLine.CenterLastLineSelection replacements = False End If endr: 'המשך של החרגות End If End If End If End If 'המשך הלולאה Next Application.ScreenRefresh End Sub Sub WindowUnderFirstWordWholeDoc() ' 'הוספת חלון מתחת למילה הראשונה בכל המסמך 'מאת ניקיוזר ' 'הצהרת המשתנים Dim myrange As Range Dim mrange As Range Dim i As Integer Dim para As Range Dim char As Range Dim replacements As Boolean Dim solveletters As VbMsgBoxResult 'סיווג פיסקאות Dim exclude2Lines As Boolean Dim exclude3Lines As Boolean Dim doublewindow As Boolean Dim replacemsg As Boolean exclude2Lines = MsgBox("האם ברצונך להוסיף חלון בפיסקאות עם 2 שורות?", vbQuestion + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "מאקרו חלון מתחת למילה הראשונה") = vbNo If exclude2Lines Then exclude3Lines = MsgBox("האם ברצונך להוסיף חלון בפיסקאות עם 3 שורות?", vbQuestion + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "מאקרו חלון מתחת למילה הראשונה") = vbNo End If If exclude3Lines Then GoTo nodouble doublewindow = MsgBox("האם ברצונך לעצב חלון כפול בפיסקאות עם שלוש שורות?", vbQuestion + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "מאקרו חלון מתחת למילה הראשונה") = vbYes nodouble: 'בחירת טווח הלולאה Selection.WholeStory Set myrange = Selection.Range Set mrange = Selection.Range myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End mrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End 'מניעת בעיות עם סימוני הערות שוליים Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting mrange.Find.Execute FindText:="^f", ReplaceWith:="^&%?!#...", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll mrange.Find.Execute FindText:="%?!#... ", ReplaceWith:=ChrW(8194), Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll mrange.Find.Execute FindText:="%?!#...", ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll 'מניעת בעיות עם חלונות קודמים mrange.Find.Execute FindText:=vbVerticalTab & " ", ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll 'מניעת בעיות עם שורה אחרונה With mrange.Find .Execute FindText:=Chr(11) & vbTab If .Found = True Then replacemsg = MsgBox("כדי למנוע בעיות מומלץ להסיר את עיצוב מירכוז שורה אחרונה. האם להסיר מירכוז שורה אחרונה כעת?", _ vbExclamation + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "מאקרו חלון מתחת למילה הראשונה") = vbYes If replacemsg Then .Execute FindText:=Chr(11) & vbTab, ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll replacements = True End If End If End With Application.ScreenRefresh 'תחילת הלולאה For i = 1 To myrange.Paragraphs.count Set para = myrange.Paragraphs(i).Range 'טווח הפיסקאות ' החרגות If Not para.ComputeStatistics(wdStatisticLines) <> 1 Then GoTo nxt If Not para.ParagraphFormat.Alignment <> wdAlignParagraphCenter Then GoTo nxt If para.Style Like "כותרת*" Then GoTo nxt If para.Style Like "Heading*" Then GoTo nxt If Not para.ComputeStatistics(wdStatisticLines) <> 2 And exclude2Lines Then GoTo nxt If Not para.ComputeStatistics(wdStatisticLines) <> 3 And exclude3Lines Then GoTo nxt If Not para.ComputeStatistics(wdStatisticLines) <> 3 And doublewindow Then GoTo nxt 'If Not para.ComputeStatistics(wdStatisticLines) <> 2 Then replacements = False 'שלב א העמדת הסמן אחרי הרווח הראשון בפיסקה With para .Collapse: .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd If .Previous(count:=2) = Chr(93) Or .Previous(count:=2) = Chr(41) Then 'מניעת בעיות If solveletters = vbNo Then GoTo skp If solveletters = vbYes Then GoTo doit solveletters = MsgBox("ייתכן שהמילה הראשונה משמשת כסימון של סימנים. האם להרחיב את החלון עד מתחת למילה השנייה?", vbQuestion + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "מאקרו חלון מתחת למילה הראשונה") If solveletters = vbNo Then GoTo skp doit: If solveletters Then .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd End If 'עד כאן מניעת בעיות skp: .Select End With 'שלב ב הוספת החלון With Selection .EndKey Unit:=wdLine If .Text = Chr(13) Then GoTo nxt If .Text = Chr(11) Then .Delete Unit:=wdCharacter, count:=1 'מניעת בעיות .TypeText Text:=Chr(11) & ChrW(8197) Set char = Selection.Range .Previous.Font.Spacing = char.Information(wdHorizontalPositionRelativeToTextBoundary) - para.Information(wdHorizontalPositionRelativeToTextBoundary) End With 'המשך הלולאה nxt: Next Application.ScreenRefresh 'המשך של מניעת בעיות כלליות If replacements = True Then Dim rtrnlstln As Boolean rtrnlstln = MsgBox("האם להחזיר עיצוב שורה אחרונה כעת?", vbQuestion + vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading, "מאקרו חלון מתחת למילה הראשונה") = vbYes If rtrnlstln Then Call LastLine.CenterLastLineWholeDoc End If If doublewindow Then Selection.WholeStory Call DoubleWindowUnderFirstWordSelection End If End Sub Sub RemoveWindowUnderFirstWordSelected() Dim myrange As Range Set myrange = Selection.Range Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End myrange.Find.Execute FindText:=vbVerticalTab & " ", ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll Application.ScreenRefresh End Sub Sub RemoveWindowUnderFirstWordWholeDoc() Dim myrange As Range Selection.WholeStory Set myrange = Selection.Range Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End myrange.Find.Execute FindText:=vbVerticalTab & " ", ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll Application.ScreenRefresh End Sub Sub WindowUnderManyWordsSelection() ' 'הוספת חלון מתחת למילה הראשונה בפיסקאות שנבחרו 'מאת ניקיוזר ' 'הצהרת המשתנים Dim myrange As Range Dim i As Integer Dim para As Range Dim char As Range Dim replacements As Boolean Dim iterations As Integer Dim x As Integer 'בחירת טווח הלולאה Set myrange = Selection.Range On Error Resume Next iterations = InputBox("כתבו במספרים מתחת לכמה מילים תרצו להחיל את החלון") On Error GoTo 0 myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting myrange.Find.Execute FindText:="^f", ReplaceWith:="^&%?!#...", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll myrange.Find.Execute FindText:="%?!#... ", ReplaceWith:=ChrW(8194), Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll myrange.Find.Execute FindText:="%?!#...", ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll 'מניעת בעיות כלליות myrange.SetRange Selection.Paragraphs.First.Range.Start, Selection.Paragraphs.Last.Range.End Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With myrange.Find .Execute FindText:=Chr(11) & vbTab, ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll If .Found = True Then replacements = True End If .Execute FindText:=Chr(11) & ChrW(8197), ReplaceWith:="", Forward:=True, Wrap:=wdFindStop, Replace:=wdReplaceAll End With 'תחילת הלולאה For i = 1 To myrange.Paragraphs.count Set para = myrange.Paragraphs(i).Range 'טווח הפיסקאות ' החרגות If para.ComputeStatistics(wdStatisticLines) <> 1 Then If para.ParagraphFormat.Alignment <> wdAlignParagraphCenter Then If Not para.Style Like "כותרת*" Then If Not para.Style Like "Heading*" Then 'If Not para.ComputeStatistics(wdStatisticLines) <> 2 Then replacements = False 'שלב א העמדת הסמן אחרי הרווח הראשון בפיסקה For x = 1 To iterations With para .Collapse: .MoveUntil cset:=" ": .MoveEnd: .Collapse Direction:=wdCollapseEnd .Select End With Next x 'שלב ב הוספת החלון With Selection .EndKey Unit:=wdLine If .Text = Chr(13) Then GoTo nxt If .Text = Chr(11) Then .Delete Unit:=wdCharacter, count:=1 'מניעת בעיות .TypeText Text:=Chr(11) & ChrW(8197) Set char = Selection.Range .Previous.Font.Spacing = char.Information(wdHorizontalPositionRelativeToTextBoundary) - para.Information(wdHorizontalPositionRelativeToTextBoundary) End With 'המשך של מניעת בעיות כלליות If replacements = True Then With para .Collapse: .MoveUntil Chr(13): .MoveEnd: .Collapse Direction:=wdCollapseEnd .End = .End - 1 ' subtract 1 from the end position .Select End With Selection.HomeKey Unit:=wdLine 'מניעת בעיות With Selection If .Text = ChrW(8197) Then GoTo nxt If .Previous.Text = Chr(11) Then .Previous.Delete Unit:=wdCharacter, count:=1 End With 'הוספת טאב ידני Dim middlePosition As Double middlePosition = Selection.Sections(1).PageSetup.TextColumns(1).Width / 2 With Selection .ParagraphFormat.TabStops.ClearAll .ParagraphFormat.TabStops.Add Position:=middlePosition, Alignment:=wdAlignTabCenter End With Selection.TypeText Chr(11) & vbTab 'המשך של החרגות End If End If End If End If End If 'המשך הלולאה nxt: Next Application.ScreenRefresh End Sub
-
@pcinfogmach
לגבי המאקרו של המרת מספרים לאותיות של @מגדלים כיצד ניתן לשנות אותו שיחול רק על בחירה?
תודה רבה -
@דאנציג כתב בשיתוף | תגובות ל - אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות:
לגבי המאקרו של המרת מספרים לאותיות של @מגדלים כיצד ניתן לשנות אותו שיחול רק על בחירה?
לא התעמקתי מדי אבל לכאורה
יש להגדיר טווח לפני שורת הקוד
start:
כך:
Dim slctdRange as Range set slctdRange = Selection.Range start:
ובהמשך הקוד במקום
With Selection.Find
לעשות
with slctdRange.find .Wrap = wdFindStop
ושאר המאקרו כרגיל
כל זה אם אתה מדבר על בחירה ברצף אם מדובר על בחירה שלא ברצף ייתכן שצריך לעשות לזה אילתור. אם זה רלוונטי והקוד הנ"ל עבד לבחירה ברצף ולא לבחירה שלא ברצף כתוב לי ואכתוב לך כיצד בלי נדר.