אופיס 365 עזרה בשדרוג מאקרו

שיקול דעת · 7/1/21

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

אבל הייתי רוצה לשדרג המאקרו, בשתי דברים - כל אחד לחוד - ואשמח עם מישהו יוכל לעזור לי.

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

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

זהו המאקרו כפי שהקלטתי אותו:

קוד:

Sub התחל_מאות_א_אחרי_כותרת3()
'
' Macro1 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("כותרת 3")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    Selection.Find.Execute
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("טקסט ממוספר")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    Selection.Find.Execute
    With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(1)
        .NumberFormat = "%1."
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleHebrew1
        .NumberPosition = CentimetersToPoints(0)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = CentimetersToPoints(0.5)
        .TabPosition = wdUndefined
        .ResetOnHigher = 0
        .StartAt = 1
        With .Font
            .Bold = wdUndefined
            .Italic = wdUndefined
            .StrikeThrough = wdUndefined
            .Subscript = wdUndefined
            .Superscript = wdUndefined
            .Shadow = wdUndefined
            .Outline = wdUndefined
            .Emboss = wdUndefined
            .Engrave = wdUndefined
            .AllCaps = wdUndefined
            .Hidden = wdUndefined
            .Underline = wdUndefined
            .Color = wdColorAutomatic
            .Size = 12
            .Animation = wdUndefined
            .DoubleStrikeThrough = wdUndefined
            .Name = ""
            .SizeBi = 12
            .NameBi = "Fb Nevo Medium"
            .BoldBi = False
            .ItalicBi = False
        End With
        .LinkedStyle = "טקסט ממוספר"
    End With
    ListGalleries(wdOutlineNumberGallery).ListTemplates(7).Name = ""
    Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
        ListGalleries(wdOutlineNumberGallery).ListTemplates(7), _
        ContinuePreviousList:=False, ApplyTo:=wdListApplyToWholeList, _
        DefaultListBehavior:=wdWord10ListBehavior
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub

מודה מראש לכל העוזרים!

Yisrael · 11/1/21

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

אבל הייתי רוצה לשדרג המאקרו, בשתי דברים - כל אחד לחוד - ואשמח עם מישהו יוכל לעזור לי.

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

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

זהו המאקרו כפי שהקלטתי אותו:

קוד:

Sub התחל_מאות_א_אחרי_כותרת3() ' ' Macro1 Macro ' ' Selection.Find.ClearFormatting Selection.Find.Style = ActiveDocument.Styles("כותרת 3") With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True End With Selection.Find.Execute Selection.Find.ClearFormatting Selection.Find.Style = ActiveDocument.Styles("טקסט ממוספר") With Selection.Find .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True End With Selection.Find.Execute With ListGalleries(wdOutlineNumberGallery).ListTemplates(1).ListLevels(1) .NumberFormat = "%1." .TrailingCharacter = wdTrailingTab .NumberStyle = wdListNumberStyleHebrew1 .NumberPosition = CentimetersToPoints(0) .Alignment = wdListLevelAlignLeft .TextPosition = CentimetersToPoints(0.5) .TabPosition = wdUndefined .ResetOnHigher = 0 .StartAt = 1 With .Font .Bold = wdUndefined .Italic = wdUndefined .StrikeThrough = wdUndefined .Subscript = wdUndefined .Superscript = wdUndefined .Shadow = wdUndefined .Outline = wdUndefined .Emboss = wdUndefined .Engrave = wdUndefined .AllCaps = wdUndefined .Hidden = wdUndefined .Underline = wdUndefined .Color = wdColorAutomatic .Size = 12 .Animation = wdUndefined .DoubleStrikeThrough = wdUndefined .Name = "" .SizeBi = 12 .NameBi = "Fb Nevo Medium" .BoldBi = False .ItalicBi = False End With .LinkedStyle = "טקסט ממוספר" End With ListGalleries(wdOutlineNumberGallery).ListTemplates(7).Name = "" Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _ ListGalleries(wdOutlineNumberGallery).ListTemplates(7), _ ContinuePreviousList:=False, ApplyTo:=wdListApplyToWholeList, _ DefaultListBehavior:=wdWord10ListBehavior Selection.MoveLeft Unit:=wdCharacter, Count:=1 End Sub

מודה מראש לכל העוזרים!

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

קוד:

Sub Reset_list()
Dim ListTemp As ListFormat

TitleStyle = InputBox("הכנס את שם הכותרת לחיפוש")
    If TitleStyle = Empty Then
        MsgBox "לא הוכנסו נתונים"
        Exit Sub
    End If
For i = 1 To ActiveDocument.Paragraphs.Count
    With Selection
        With .Find
            .ClearFormatting
            .Style = ActiveDocument.Styles(TitleStyle)
            .text = ""
            .Wrap = wdFindContinue
            .Execute
        End With
        If .Find.Found = True Then
            .MoveRight Count:=1
            Set ListTemp = .Range.ListFormat
            ListTemp.ApplyListTemplate ListTemplate:=ListTemp.ListTemplate, _
             ContinuePreviousList:=False
        Else: Exit For
        End If
    End With
Next i
End Sub

שיקול דעת · 11/1/21

ראשית כל ייש"כ גדול.
לא היה באפשרותו לבדוק את טיב המאקרו כי אני מקבל הודעת שגיאה הבאה:

יצויין, כי מאקרואים אחרים עובדים טוב.

שיקול דעת · 11/1/21

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

Yisrael · 11/1/21

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

קוד:

Sub Reset_list()
Dim ListTemp As ListFormat, myrange As Range
Set myrange = ActiveDocument.Paragraphs.Last.Range
TitleStyle = InputBox("הכנס את שם הכותרת לחיפוש")
    If TitleStyle = Empty Then
        MsgBox "לא הוכנסו נתונים"
        Exit Sub
    End If
For i = 1 To ActiveDocument.Paragraphs.Count
    With Selection
        With .Find
            .ClearFormatting
            .Style = ActiveDocument.Styles(TitleStyle)
            .text = ""
            .Wrap = wdFindContinue
            .Execute
        End With
        If .Find.Found = True Then
            .MoveRight Count:=1
                Do While .Range.ListFormat.ListType = 0
                   If Selection.Paragraphs(1).Range.start = myrange.start Then Exit For
                  .MoveDown unit:=wdParagraph, Count:=1
                Loop
            Set ListTemp = .Range.ListFormat
            ListTemp.ApplyListTemplate ListTemplate:=ListTemp.ListTemplate, _
             ContinuePreviousList:=False
        Else: Exit For
        End If
    End With
Next i
End Sub

שיקול דעת · 12/1/21

לצערי, עדיין לא עובד.

Yisrael · 12/1/21

נכתב ע"י שיקול דעת:
לצערי, עדיין לא עובד.

יש הודעת שגיאה?
תעלה את הקובץ או חלק ממנו שבו הבעיה

שיקול דעת · 12/1/21

לא, כוונתי שעדיין אינו תופס פסקאות ממוספרים אם יש פסקה רגילה לפני כן.

Yisrael · 13/1/21

נכתב ע"י שיקול דעת:
לא, כוונתי שעדיין אינו תופס פסקאות ממוספרים אם יש פסקה רגילה לפני כן.

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

שיקול דעת · 14/1/21

אני מודה לי על הקדשת הזמן עבורי.

Yisrael · 14/1/21

נכתב ע"י שיקול דעת:
אני מודה לי על הקדשת הזמן עבורי.

למה אני לא רואה שיש סגנונות לכותרות? מופיע לי כאילו הכל בסגנון 'רגיל', אצלך זה גם ככה?

שיקול דעת · 15/1/21

אכן, לא שמתי לב. אני מעלה קובץ אחר.

Yisrael · 17/1/21

נכתב ע"י שיקול דעת:
אכן, לא שמתי לב. אני מעלה קובץ אחר.

מה זה הקובץ הזה? זה קובץ ריק...

שיקול דעת · 17/1/21

אני לא מבין מה קורה פה.
העליתי לך קובץ אחר.

Yisrael · 18/1/21

נכתב ע"י שיקול דעת:
אני לא מבין מה קורה פה.
העליתי לך קובץ אחר.

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