שיתוף | "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.

[pcinfogmach]

@דאנציג כתב בשיתוף | "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.:

אבל, בתיבת טקסט שניהם לא עובדים...

ושל שלמה מימות כן?

[דאנציג]

@pcinfogmach כן

[pcinfogmach]

חיפוש והחלפה באבני בניין
חיפוש והחלפה עם אבני בניין.dotm

[mfmf]

המרת סוגריים מסולסלות להערות שוליים.
{כל מה שנמצא בתוך הסוגריים} הופך להערה. ניתן לשנות במאקרו לכל סוגי הסוגריים או לסימונים אחרים.
סוגריים מסולסלות להערות שוליים.dotm
קרדיט @yisrael בפרוג.

[שלל]

@דאנציג יכלת גם להגדיר לזה קיצור מקשים מותאם אישית... לשם הידע..

[ASDF1345]

מצורף מסמך שמכיל מספר פקודות מאקרו: א. הפניה מקושרת ב. אינדקס ג. פקודות שקשורות לתצוגת טויטה
עריכה: מצורף קובץ יותר מעודכן מאקרו הפניה מקושרת אינדקס תצוגת טויטה.dotm

[pcinfogmach]

@ASDF1345
מומלץ לציין מה בדיוק השתנה בעדכון

[ASDF1345]

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

[ASDF1345]

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

Sub הוספת_מעבר_עמוד_לפי_סגנון_כל_המסמך()
'
' הוספת_מעבר_עמוד_לפי_סגנון_כל_המסמך Macro
'
'

Application.ScreenUpdating = False

Selection.Find.ClearFormatting
SIGNON = Selection.Style

Dim my_undo As Object
Set my_undo = Application.UndoRecord
my_undo.StartCustomRecord ("הוספת מעבר עמוד לפי סגנון")
On Error GoTo ending

Dim rng, oRange As Range
Set rng = Selection.Range

Selection.WholeStory
Set oRange = Selection.Range
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "#^p"
        .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
    Selection.Find.Execute Replace:=wdReplaceAll
    
start:
With Selection.Find
    .ClearFormatting
        .Text = "#"
        .Style = SIGNON
        .Forward = True
        .Wrap = wdFindContinue
        Selection.Find.Execute
    
    If Not Selection.Range.InRange(oRange) Then GoTo ext
    If .Found = True Then
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdLine
    Selection.InsertBreak Type:=0
    
GoTo start
    End If
End With


ext:
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "#"
        .Replacement.Text = ""
        .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
    Selection.Find.Execute Replace:=wdReplaceAll
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .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


rng.Select

ending:
my_undo.EndCustomRecord

Application.ScreenUpdating = True

End Sub

[מניין]

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

Sub מחזיר_לטור_אחד_לפי_כותרת()
    Dim Alerts As Boolean
    Dim a As Boolean
    Dim headingName As String
    Dim para As Paragraph
    Dim section As section
    Dim inSelectedHeading As Boolean
    Dim userChoice As VbMsgBoxResult ' המשתנה לשמירת הבחירה של המשתמש
    Dim deleteParagraphBreaks As VbMsgBoxResult ' משתנה לשמירת הבחירה בנוגע למחיקת מעברי פסקאות מיותרים

    ' התחל Undo Record
    Application.UndoRecord.StartCustomRecord "החזרת לטור אחד לפי כותרת"
    
    ' חסום הודעות והתראות
    Alerts = Application.DisplayAlerts
    Application.DisplayAlerts = wdAlertsNone
    Application.ScreenUpdating = False
    
    ' בקשת קלט מהמשתמש
    headingName = InputBox("הזן את שם הכותרת שברצונך לשנות לטור אחד:", "בחירת כותרת")
    
    ' בדיקת קלט מהמשתמש
    If headingName = "" Then
        MsgBox "לא הוזנה כותרת. הפעולה בוטלה.", vbExclamation
        Exit Sub
    End If
    
    ' שאל את המשתמש אם הוא רוצה להחיל על כל המסמך או רק על הפסקה הבאה
    userChoice = MsgBox("האם ברצונך להחיל את השינוי על כל המסמך?", vbYesNoCancel + vbQuestion, "בחירת היקף פעולה")
    
    If userChoice = vbCancel Then
        MsgBox "הפעולה בוטלה.", vbExclamation
        Exit Sub
    End If

    ' מעבר לנקודת התחלה - אם הפסקה הבאה, אין מעבר לראש המסמך
    If userChoice = vbNo Then
        ' המשך מהפסקה הנוכחית
        Selection.MoveDown Unit:=wdParagraph, Count:=1
    Else
        ' אם על כל המסמך, התחל מההתחלה
        Selection.HomeKey Unit:=wdStory
    End If

    ' מעבר על כל הפסקאות במסמך (או פסקה אחת אם המשתמש בחר "לא")
    Do
        Selection.Find.ClearFormatting
        ' חיפוש לפי סגנון כותרת
        With Selection.Find
            .Style = headingName ' חיפוש לפי סגנון הכותרת
            .Text = "^$"
            .Forward = True
            .Wrap = wdFindStop
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchControl = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        
        ' אם נמצא את הכותרת לפי הסגנון
        a = Selection.Find.Execute
        If a = True Then
            ' יצירת שבירת מקטע לפני ואחרי הכותרת
            Selection.Paragraphs(1).Range.Select
            ActiveDocument.Range(Start:=Selection.Start, End:=Selection.Start). _
                InsertBreak Type:=wdSectionBreakContinuous
            Selection.Start = Selection.Start + 1
            ActiveDocument.Range(Start:=Selection.End, End:=Selection.End).InsertBreak _
                Type:=wdSectionBreakContinuous
            
            ' הגדרת הטורים של המקטע לטור אחד
            With Selection.PageSetup.TextColumns
                .SetCount numColumns:=1
                .EvenlySpaced = True
                .LineBetween = False
            End With
            
            ' מעבר לפסקה הבאה אם יש צורך
            Selection.MoveRight Unit:=wdCharacter, Count:=1
        End If
    Loop While a = True And (userChoice = vbYes)

    ' שאל אם למחוק מעברי פסקאות מיותרים
    deleteParagraphBreaks = MsgBox("האם ברצונך למחוק מעברי מקטע מיותרים?", vbYesNo + vbQuestion, "מחיקת מעברים מיותרים")

    If deleteParagraphBreaks = vbYes Then
        ' הפעל את המאקרו שמסיר את שבירות המקטע הכפולות ותחילת המסמך
        Call מחיקת_מעברים_מיותרים
    End If

    ' שחזור הגדרות התראות
    Application.DisplayAlerts = Alerts
    Application.ScreenUpdating = True

    ' סיים את Undo Record
    Application.UndoRecord.EndCustomRecord

    MsgBox "הפעולה הושלמה! ניתן לבטל את כל השינויים באמצעות Ctrl+Z.", vbInformation
End Sub

Sub מחיקת_מעברים_מיותרים()
    Dim sectionBreakRange As Range
    Dim paraBefore As Range
    Dim paraAfter As Range

    ' מעבר לתחילת המסמך
    Selection.HomeKey Unit:=wdStory

    ' מחיקת מעברי מקטע כפולים
    Do While Selection.Find.Execute(FindText:="^b^b", MatchWildcards:=False, Forward:=True, Wrap:=wdFindStop) = True
        Selection.Delete ' מחק מעבר מקטע כפול
    Loop

    ' מחיקת מעבר מקטע בודד בתחילת המסמך (אם קיים)
    Selection.HomeKey Unit:=wdStory
    If Selection.Find.Execute(FindText:="^b", MatchWildcards:=False, Forward:=True, Wrap:=wdFindStop) = True Then
        If Selection.Start = 0 Then
            Selection.Delete ' מחק מעבר המקטע בתחילת המסמך
        End If
    End If

    ' מחיקת מעברי מקטע בין פסקאות בטור אחד
    Selection.HomeKey Unit:=wdStory
    Do While Selection.Find.Execute(FindText:="^b", MatchWildcards:=False, Forward:=True, Wrap:=wdFindStop) = True
        ' הגדרת הטווח למעבר המקטע שנמצא
        Set sectionBreakRange = Selection.Range

        ' בדיקת הפסקאות לפני ואחרי מעבר המקטע
        If sectionBreakRange.Start > 0 Then
            On Error Resume Next ' טיפול במקרים שבהם אין פסקאות סמוכות
            Set paraBefore = sectionBreakRange.Paragraphs(1).Range.Previous(wdParagraph, 1)
            Set paraAfter = sectionBreakRange.Paragraphs(1).Range.Next(wdParagraph, 1)
            On Error GoTo 0

            If Not paraBefore Is Nothing And Not paraAfter Is Nothing Then
                ' בדיקה אם שתי הפסקאות הן באותו טור (טור יחיד)
                If paraBefore.PageSetup.TextColumns.Count = 1 And _
                   paraAfter.PageSetup.TextColumns.Count = 1 Then
                   
                    ' מחיקת מעבר המקטע
                    sectionBreakRange.Delete
                End If
            End If
        End If

        ' המשך לחיפוש הבא
        Selection.Start = sectionBreakRange.Start
        Selection.Collapse Direction:=wdCollapseEnd
    Loop
End Sub

Spoiler

שוה בדיקה

עריכה: הוכנסו שני תיקונים במאקרו, יש להוריד מחדש.
עריכה נוספת: נוסף אפשרות לשחזר את כל השינויים בלחיצה אחת על Ctrl+Z

[מניין]

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

Sub סימון_תחילת_וסוף_עמוד()
    Dim doc As Document
    Dim rng As Range
    Dim pageCount As Integer
    Dim i As Integer
    Dim firstWord As Range
    Dim lastWord As Range
    
    ' קבלת המסמך הפעיל
    Set doc = ActiveDocument
    pageCount = doc.ComputeStatistics(wdStatisticPages)
    
    ' מעבר על כל עמוד במסמך
    For i = 1 To pageCount
        ' הגדרת טווח העמוד
        Set rng = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
        rng.End = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i + 1).Start
        rng.End = rng.End - 1 ' להוציא את הסימן של עמוד חדש
        
        ' סימון המילה הראשונה
        Set firstWord = rng.Words(1)
        firstWord.HighlightColorIndex = wdBrightGreen
        
        ' סימון המילה האחרונה
        Set lastWord = rng.Words(rng.Words.Count)
        lastWord.HighlightColorIndex = wdRed
    Next i
    
    MsgBox "המאקרו הסתיים בהצלחה!", vbInformation
End Sub

[menajemmendel]

@מניין

Sub First_and_last_word_highlighting()

Dim page As Range, lastWordNumber As Integer, pageCount As Integer

    pageCount = ActiveDocument.ComputeStatistics(wdStatisticPages)
       For i = 1 To pageCount
            Selection.GoTo What:=wdGoToPage, Name:=i
            Set page = ActiveDocument.Bookmarks("\page").Range
            lastWordNumber = page.Words.Count
            page.Words(1).HighlightColorIndex = wdGreen
            page.Words(lastWordNumber).HighlightColorIndex = wdRed
        Next i
    MsgBox "המאקרו הסתיים בהצלחה!" & vbCr & vbCr & _
           "מאקרו מבית מאיר עיני חכמים-הבית לאוטומציה בוורד"
End Sub

[מניין]

פוסט זה נמחק!

[u88]

@menajemmendel למה זה?

[א. ד. ג.]

https://mitmachim.top/topic/78070/מדריך-אפלקציית-הגרלות-למחשב-באמצעות-פקודות-מאקרו-בוורד?_=1735114384700

[menajemmendel]

@u88 כתב בשיתוף | "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.:

@menajemmendel למה זה?

זה תגובה לבקשת @מניין כאן (שביקש אם מישהו יכול לכתוב קוד שיעבוד גם בשתי טורים).

[menajemmendel]

המאקרו המהפכני שכולם חיכו לו - חובה בכל מחשב!

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

הכירו את המאקרו
מאקרו חדשני שמאפשר לספור כמה פעמים מופיעות אותיות מסוימות במסמך וורד! כן, שמעתם נכון!
הכלי הזה יאפשר לכם:
1️⃣ לגלות באילו אותיות אתם משתמשים הכי הרבה – אולי תגלו שאותיות כמו "צ" ו-"ף" זוכות להזנחה חמורה!
2️⃣ להבין לעומק את סגנון הכתיבה שלכם – מה זה אומר עליכם אם האות "ת" מופיעה פי שניים מהאות "א"? (התשובה: הרבה).
3️⃣ להרגיש מתוחכמים יותר מכל החברים שלכם, כי יש לכם מאקרו של מיספור אותיות וזה בדיוק מה שחסר להם בחיים שלהם.

למי זה מתאים?

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

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

אז למה אתם מחכים?
לחצו עכשיו על הקוד וצאו למסע שאפילו אילון מאסק עוד לא העז לחלום עליו!

Sub arraySample()
Dim otiot(1 To 22) As String
Dim otiotNumber(1 To 22) As Integer
Dim olddoc As Document
Dim newdoc As Document

otiot(1) = "א"
otiot(2) = "ב"
otiot(3) = "ג"
otiot(4) = "ד"
otiot(5) = "ה"
otiot(6) = "ו"
otiot(7) = "ז"
otiot(8) = "ח"
otiot(9) = "ט"
otiot(10) = "י"
otiot(11) = "כ"
otiot(12) = "ל"
otiot(13) = "מ"
otiot(14) = "נ"
otiot(15) = "ס"
otiot(16) = "ע"
otiot(17) = "פ"
otiot(18) = "צ"
otiot(19) = "ק"
otiot(20) = "ר"
otiot(21) = "ש"
otiot(22) = "ת"

Set olddoc = ActiveDocument
Set newdoc = Documents.Add

For i = LBound(otiot) To UBound(otiot)
    otiotNumber(i) = Len(olddoc.Range) - Len(Replace(olddoc.Range, otiot(i), ""))
    newdoc.Range.InsertAfter otiot(i) & " מופיע " & otiotNumber(i) & " מספר פעמים" & vbCr
Next i

newdoc.Activate

End Sub

[צדיק וטוב לו 0]

@menajemmendel הוא עובד גם אותיות סופיות?
(אגב, מה הבעיה לספור דרך החיפוש פשוט של וורד?)

[u88]

@צדיק-וטוב-לו-0 הוא לא עובד על אותיות סופיות אבל אפשר להוסיף תראה שבשורה 2 ובשורה 3 כתוב שיש 22 מופעים של אותיות אז תוסיף אחרי שורה 28 את הקוד של האות (כמו אחת האותיות לפני) ותכתוב שם מה שאתה רוצה (רק לא לשכוח לעדכן בקוד למעלה מספר מופעים ( otiot)

[menajemmendel]

@צדיק-וטוב-לו-0 כתב בשיתוף | "מתעדכן" אוסף מאקרו לוורד - אינדקס מאקרו שימושי + הוראות חשובות.:

(אגב, מה הבעיה לספור דרך החיפוש פשוט של וורד?)

0

כאן אתה מקבל דו''ח, וגם כולם בבת אחת, לא צריך לעשות אחד אחד