בקשה | בקשה | מאקרו בוורד להפיכת תו / קוד מסויים למספור אוטומטי רץ (באותיות)
-
@HMJE
הנני להביא משהו ראשוני לצורך הבנת הענין והשיפור והתיקון ע"י הציבור (מחליף את "ממ" )
בעזרת ה' אנסה לעבוד על זה גם כןקוד למספר רץ במספרים
Sub אאאא_החלפה() ' ' Macro1 Macro ' ' For I = 1 To 150 Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "ממ" .Replacement.Text = I .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With With Selection If .Find.Forward = True Then .Collapse Direction:=wdCollapseStart Else .Collapse Direction:=wdCollapseEnd End If .Find.Execute Replace:=wdReplaceOne If .Find.Forward = True Then .Collapse Direction:=wdCollapseEnd Else .Collapse Direction:=wdCollapseStart End If .Find.Execute End With Next I End Sub
הבעיה שצריך לקבוע מראש עד כמה יעשה כי סתם מידי הרבה מכביד על המאקרו
וכמו כן לאותיות כרגע מא- עד ת
Sub אאאא_החלפה() ' ' Macro1 Macro ' ' For I = 1488 To 1514 Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "ממ" .Replacement.Text = ChrW(I) .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With With Selection If .Find.Forward = True Then .Collapse Direction:=wdCollapseStart Else .Collapse Direction:=wdCollapseEnd End If .Find.Execute Replace:=wdReplaceOne If .Find.Forward = True Then .Collapse Direction:=wdCollapseEnd Else .Collapse Direction:=wdCollapseStart End If .Find.Execute End With Next I End Sub
וכשמגיע לת גומר את מאקרו
בתקווה שעזרתי
(וכמו כן יכול להיות שאפשר למחוק כמה שורות לא עברתי על זה לעומק) -
@רפרם-ב-ר-פפא ראשית כל, תודה רבה רבה, ובפרט על המענה המהיר...
@רפרם-ב-ר-פפא כתב בבקשה | בקשה | מאקרו בוורד להפיכת תו / קוד מסויים למספור אוטומטי רץ (באותיות):
הבעיה שצריך לקבוע מראש עד כמה יעשה כי סתם מידי הרבה מכביד על המאקרו
איפה מגדירים עד כמה יעשה?
בשורה הזאתFor I = 1 To 150
ובאותיות זהFor I = 1488 To 1514
?ובדרך אגב אני שואל שאלת תם, האם יש כזה אופציה שהמאקרו יעשה חיפוש כמה פעמים קיים התו אותו רוצים להחליף, ואז הוא יגדיר את עצמו אוטומטית עד איפה צריך לרוץ.
למשל בקוד שכתבת שהוא מחליף את "ממ" אז אולי אפשר שהמאקרו יחפש כמה פעמים זה קיים, ולמשל הוא קיים 149 פעמים, אז הוא יריץ - במספרים למשל מ-1 עד 149, ובאותיות מ-1488 עד 1637 (בתקוה שאכן הבנתי מה הם המספרים 1488, שכפי הבנתי זה אות א' וכו' ו-1514 זה ת'... אני צודק?), ואז אולי זה לא יכביד הרבה על המאקרו.נ.ב. במאקרו הזה שעשית לאותיות, הוא ממספר את האותיות [א...ת] ולא [א...י, יא...כ...], כמו"כ הוא מכניס גם אותיות סופיות...
למעשה מה שחשבתי אולי פתרון (כמובן שזה בתיאוריה, כי אין לי מושג איך עושים את זה). לעשות כמו שכתבתי לעיל, שדבר ראשון יחפש כמה פעמים יש את התו אותו רוצים להחליף, ואז יכניס את המספר עד איפה לרוץ, [ושיריץ את המאקרו על מספרים - (ואולי עם איזה סימון לפני ואחרי המספר בשביל לזהות את זה גם אח"כ כדלהלן בשורה הבאה)].
ועכשיו לגבי האותיות שיעשה את זה נכון, אולי אפשר להוסיף במאקרו, או אפי' במאקרו נוסף המרה של המספרים לאותיות, למשל 1=א, 10=י, 100=ק, וכן ע"ז הדרך...
עריכה: לגבי המרה ממספרים לאותיות, מצאתי כאן - קוד VBA להמיר בוורד ממספרים לאותיות, ש @מגדלים כתב, אולי אפשר עם זה לעשות משהו בענין.מקווה שהסברתי את עצמי טוב...
בכל אופן תודה רבה רבה
ואם יש פתרון גם להנ"ל כך או בצורה אחרת אשמח אם תוכל לעדכן. -
@HMJE יש לזה קוד אוטומטי ב'שדה', בחר את האופציה שמסומן בתמונה, וזה מכניס קוד seq, ואח"כ מעתיקים את הקוד שנוצר לכל מקום שאתה רוצה, כמו כן אפשר לעשות כמה סדרות, אם רוצים פרק וסעיף קטן, אפשר להוסיף ליד הקוד [בחלון הקטן של קודי שדה בצד שמאל] איזה תו שרוצים עם רווח ביניהם, ולעשות כמה סוגי קודים.
אחרי שמכניסים את הקודים במקום שרוצים, אפשר לעדכן דרך מקש f9, וגם אם היו שינויים הכל מתעדכן באופן אוטומטי לאורך המסמך.
כדי לשנות ממספרים לאותיות, אפשר לשנות באפשרויות של השדה למטה.
-
@מניין תודה רבה, זה עובד מצויין.
רק שאלה קטנה, כתבת לעיל
אחרי שמכניסים את הקודים במקום שרוצים, אפשר לעדכן דרך מקש f9, וגם אם היו שינויים הכל מתעדכן באופן אוטומטי לאורך המסמך.
למעשה לא הצלחתי לעשות את זה כ"כ, אלא הf9 מעדכן רק כשאני עומד על האות הרצויה שאני רוצה שיעדכן.
למשל הכנסתי ב10 מקומות את ההגדרה seq, ואח"כ הוספתי בעוד מקום וכדו' שאני צריך לעדכן אותם, אז אני צריך לעבור מאחד לאחד, וכשאני עומד עליו רק אז לחיצה על F9 מעדכן אותו...
יש פתרון לכך? -
@HMJE
להלן מאקרו להחלפה לשדה מספור אוטמטי
(מקל על מרוצת הכתיבה)
מחליף את כל מופעי ה"ממ" בשדה seqלשדה אוטמטי מספרים
Sub החלפה_לשדה_אוטמטי_מספרים() Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Text = "ממ" Selection.Find.MatchWildcards = True Do While Selection.Find.Execute Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _ "SEQ A", PreserveFormatting:=True Loop End Sub
לשדה אוטמטי אותיות (א... יא... קא...)
Sub החלפה_לשדה_אוטמטי_אותיות() Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Text = "ממ" Selection.Find.MatchWildcards = True Do While Selection.Find.Execute Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _ "SEQ A \* hebrew1", PreserveFormatting:=True Loop End Sub
-
@רפרם-ב-ר-פפא
תודה רבה. מושלם. -
-
-
-
@רפרם-ב-ר-פפא כתב בבקשה | בקשה | מאקרו בוורד להפיכת תו / קוד מסויים למספור אוטומטי רץ (באותיות):
Selection.Find.Text = "ממ"
Selection.Find.MatchWildcards = Trueא. במקום
Selection.Find.Text = "ממ"
אפשר לכתוב
Selection.Find.Text = InputBox("הזן סימן להחלפה")
וכך המשתמש יוכל לבחור איזה טקסט להחליף.
ב. לא הצלחתי לעשות את אותו דבר בקוד הזה
"SEQ A \* hebrew1"
, כלומר שהמשתמש יוכל להגדיר אם לעשות את זה לa או b וכדו'
-
@455 עשיתי את זה כך
אם יש בזה בעיות אשמח אם יעדכנו אותיSub החלפת_סימון_נבחר_לשדה_אוטומטי_אותיות() Dim userChoice As String userChoice = InputBox("אנא הזן אות זרם:") Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Text = InputBox("הזן סימן להחלפה:") Selection.Find.MatchWildcards = True Do While Selection.Find.Execute Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="SEQ " & userChoice & " \* hebrew1", PreserveFormatting:=True Loop End Sub