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

[יאיר דניאל]

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

Sub חזרה_מהערה_לטקסט()
'
' חזרה_מהערה_לטקסט Macro
'
'
    If ActiveWindow.ActivePane.View.Type = wdPrintView Or ActiveWindow. _
        ActivePane.View.Type = wdWebView Or ActiveWindow.ActivePane.View.Type = _
        wdPrintPreview Then
        ActiveWindow.View.SeekView = wdSeekMainDocument
    Else
        ActiveWindow.Panes(2).Close
    End If
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    ActiveWindow.ActivePane.SmallScroll Down:=5
End Sub

[יאיר דניאל]

בהמשך להנ"ל אני משתף עוד שני מאקרואים - להצגת הערות שוליים.
(הבהרה חשובה: לא אני כתבתי את המאקרואים האלו - זה נכתב ע"י @שלמה11 בעקבות הבקשה שלי כאן וכאן)

מי שעובר על מה שהוא כתב, ויש הערת שוליים - צריך לגרור את העכבר ולרחף מעל מספר ההערה בכדי לראות את הכיתוב בהערה.

מאקרו "מציג תוכן הערות"

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

אז הנה המאקרו:

Sub מציג_תוכן_הערות()
    
    Dim rng As Range
    Set rng = Selection.Range
    rng.MoveStart wdCharacter, -1
    rng.MoveEnd wdCharacter, 1
        
    If rng.Footnotes.Count > 0 Then
        With UserForm1
            .Label1.Caption = rng.Footnotes(1).Range.Text
            .Label1.AutoSize = True
            .Label1.Width = 190
            .Height = .Label1.Height + 80
            .Show vbModeless
        End With
        On Error Resume Next
        Application.OnTime Now + TimeValue("00:00:04"), "ת"
        On Error GoTo 0
    End If
        
End Sub
Sub מציג_תוכן_הערות()
    Unload UserForm1
End Sub

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

• שימו לב בקוד - אצלי זה מוגדר ל4 שניות - תוכלו לשנות את זה לפי מה שנוח לכם.

מאקרו "מציג תוכן הערה"

• מאקרו זה - פחות "משוכלל" מהקודם, ואם תשאלו א"כ למה הבאתי אותו - למה הוא טוב.
  אז ככה: בהערות שוליים ארוכות, לא יספיק לכם מספר שניות לעבור על כל ההערה (חוץ מזה שאתם בלחץ שעוד שנייה זה נסגר...) - במאקרו הזה - בכדי שההערה תיסגר צריך ללחוץ אישור = אנטר. כך ש.. קחו את הזמן שלכם תעברו על ההערה באופן יסודי ובלי לחץ, סיימתם? פשוט לחצו אנטר ותמשיכו הלאה!

הנה המאקרו:

Sub מציג_תוכן_הערה()
'
' מציג_תוכן_הערה Macro
'
'
    Dim rng As Range
    Selection.MoveStart wdCharacter, -1
    Set rng = Selection.Range
    
    If rng.Footnotes.Count > 0 Then
        MsgBox rng.Footnotes(1).Range.Text, vbInformation, "הערת שוליים"
    End If
    Selection.Move wdCharacter, 1
End Sub

וכך זה נראה בפועל:

הערה חשובה - במאקרו הזה - חייבים שהסמן יהיה אחרי מספר ההערה, ולא לפני.

עצה שלי - תגדירו קיצור מקשים - לשני המאקרואים (אצלי זה מוגדר הראשון כ-CTRL+. והשני כ- CTRL+,) זה ישמש אתכם מלא!

Spoiler

אם אתם מעוניינים לראות בלחיצה אחת את כל ההערות שוליים בעמוד - יש את המאקרו הזה - שיצר @אביעד כאן:

Sub ShowFootnotesFromPreviousPage()
    Dim fn As Footnote
    Dim currPage As Long
    Dim prevPage As Long
    Dim msg As String
    Dim refRange As Range
    
    ' קבל את מספר העמוד הנוכחי
    currPage = Selection.Information(wdActiveEndPageNumber)
    prevPage = currPage - 1
    
    If prevPage < 1 Then
        MsgBox "אין עמוד קודם במסמך.", vbExclamation, "שגיאה"
        Exit Sub
    End If
    
    msg = ""
    
    ' עבור על כל ההערות במסמך
    For Each fn In ActiveDocument.Footnotes
        Set refRange = fn.Reference
        If refRange.Information(wdActiveEndPageNumber) = prevPage Then
            msg = msg & "• " & Trim(fn.Range.Text) & vbCrLf & vbCrLf
        End If
    Next fn
 
    If msg = "" Then
        MsgBox "אין הערות שוליים בעמוד הקודם.", vbInformation, "אין הערות"
    Else
        MsgBox "הערות שוליים בעמוד הקודם:" & vbCrLf & vbCrLf & msg, vbInformation, "הערות בעמוד " & prevPage
    End If
End Sub

[יאיר דניאל]

אם זה מעניין אתכם - תגיבו, ואעלה בל"נ עוד כמה מאקרואים קטנים לשימוש בקיצורי מקשים במקום העכבר

[אביעד]

Spoiler

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

[יאיר דניאל]

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

התיקייה שתיווצר לאחר הרצת המאקרו - לא שוקלת כמעט כלום, אבל היא תחסוך לכם הרבה עבודה - כשיימחק לכם ההגדרות איכשהו/ תאפסו את המחשב/ תעשו התקנה נקייה/ תקנו מחשב חדש!

[יש כבר מאקרו כזה שכתב אי מי מחברי הפורום, אינני זוכר מי כך שאני לא יכול לתת לו את הקרדיט המגיע לו - לגיבוי של תבנית הנורמל

Sub גיבוי_תבנית_נורמל()
    Dim fso As Object
    Dim sourcePath As String
    Dim destPath As String
    Dim fileName As String
    Dim dateTimeStamp As String
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    sourcePath = "C:\Users\ZMB\AppData\Roaming\Microsoft\Templates\"
    destPath =  **הזינו כאן את הנתיב בו תרצו לשמור את התבנית**
    dateTimeStamp = Format(Now, "dd_mm_yy_hh_mm_ss")
    
    fileName = "Normal.dotm"
    
    If Not fso.FolderExists(destPath) Then
        fso.CreateFolder destPath
    End If
    
    If fso.FileExists(sourcePath & fileName) Then
        fso.CopyFile sourcePath & fileName, destPath & Left(fileName, Len(fileName) - 5) & "_" & dateTimeStamp & ".dotm"
        
        MsgBox "הקובץ הועתק בהצלחה ונוסף לתיקיית הגיבוי."
    Else
        MsgBox "הקובץ המקורי אינו קיים."
    End If
    
    Set fso = Nothing
End Sub

והנה - זה המאקרו שלי, נסו ותהנו.
אשמח לשמוע ביקורת והצעות שיפור לזה.

Option Explicit

Sub גיבוי_ושחזור_התאמות_משתמש()

    Dim fso As Object
    Dim user As String
    Dim basePath As String
    Dim פעולה As VbMsgBoxResult
    Dim src As String, dst As String

    Set fso = CreateObject("Scripting.FileSystemObject")
    user = CreateObject("WScript.Network").UserName

    פעולה = MsgBox( _
        "בחר פעולה:" & vbCrLf & _
        "כן = גיבוי" & vbCrLf & _
        "לא = שחזור", _
        vbYesNoCancel + vbQuestion, _
        "Office PRO")

    If פעולה = vbCancel Then Exit Sub

    With Application.FileDialog(4)
        .Title = IIf(פעולה = vbYes, "בחר תיקייה לגיבוי", "בחר תיקיית גיבוי")
        If .Show <> -1 Then Exit Sub
        basePath = .SelectedItems(1)
    End With

    ' ================= UI – Excel =================
    CreateFolderIfMissing fso, basePath & "\UI"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\Excel.officeUI"
        dst = basePath & "\UI\Excel.officeUI"
    Else
        src = basePath & "\UI\Excel.officeUI"
        dst = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\Excel.officeUI"
    End If
    CopyFileSafe fso, src, dst

    ' ================= UI – Word =================
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\Word.officeUI"
        dst = basePath & "\UI\Word.officeUI"
    Else
        src = basePath & "\UI\Word.officeUI"
        dst = "C:\Users\" & user & "\AppData\Local\Microsoft\Office\Word.officeUI"
    End If
    CopyFileSafe fso, src, dst

    ' ================= Normal.dotm =================
    CreateFolderIfMissing fso, basePath & "\Word"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Templates\Normal.dotm"
        dst = basePath & "\Word\Normal.dotm"
    Else
        src = basePath & "\Word\Normal.dotm"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Templates\Normal.dotm"
    End If
    CopyFileSafe fso, src, dst

    ' ================= Office (Roaming) =================
    CreateFolderIfMissing fso, basePath & "\Office"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Office"
        dst = basePath & "\Office"
    Else
        src = basePath & "\Office"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Office"
    End If
    CopyFolderSafe fso, src, dst

    ' ================= UProof =================
    CreateFolderIfMissing fso, basePath & "\UProof"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\UProof"
        dst = basePath & "\UProof"
    Else
        src = basePath & "\UProof"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\UProof"
    End If
    CopyFolderSafe fso, src, dst

    ' ================= Spelling =================
    CreateFolderIfMissing fso, basePath & "\Spelling"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Spelling"
        dst = basePath & "\Spelling"
    Else
        src = basePath & "\Spelling"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Spelling"
    End If
    CopyFolderSafe fso, src, dst

    ' ================= Excel (Roaming) =================
    CreateFolderIfMissing fso, basePath & "\Excel"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Excel"
        dst = basePath & "\Excel"
    Else
        src = basePath & "\Excel"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Excel"
    End If
    CopyFolderSafe fso, src, dst

    ' ================= Access =================
    CreateFolderIfMissing fso, basePath & "\Access"
    If פעולה = vbYes Then
        src = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Access"
        dst = basePath & "\Access"
    Else
        src = basePath & "\Access"
        dst = "C:\Users\" & user & "\AppData\Roaming\Microsoft\Access"
    End If
    CopyFolderSafe fso, src, dst

    MsgBox IIf(פעולה = vbYes, _
        "הגיבוי הושלם בהצלחה", _
        "השחזור הושלם בהצלחה"), _
        vbInformation, "Office PRO"

End Sub

' ================= עזר =================
Sub CreateFolderIfMissing(fso As Object, path As String)
    If Not fso.FolderExists(path) Then fso.CreateFolder path
End Sub

Sub CopyFileSafe(fso As Object, src As String, dst As String)
    If fso.FileExists(src) Then
        CreateFolderIfMissing fso, fso.GetParentFolderName(dst)
        On Error Resume Next
        If fso.FileExists(dst) Then fso.DeleteFile dst, True
        fso.CopyFile src, dst, True
        Err.Clear
        On Error GoTo 0
    End If
End Sub

Sub CopyFolderSafe(fso As Object, src As String, dst As String)
    If fso.FolderExists(src) Then
        CreateFolderIfMissing fso, fso.GetParentFolderName(dst)
        fso.CopyFolder src, dst, True
    End If
End Sub

• מאקרו זה מגבה את הקבצים הבאים:
  מילון אישי
  תיקון שגיאות אוטומטי
  התאמות אישיות בוורד, אקסל, אקסס
  תבנית נורמל

[מניין]

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

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

האם זה שומר גם על כל הכרטיסיות, הקיצורי דרך, והמאקרואים.

[יאיר דניאל]

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

האם זה שומר גם על כל הכרטיסיות, הקיצורי דרך, והמאקרואים.

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