אופיס 365 מאקרו שמכניס סימון לפני איפה שמתחיל שינוי בקובץ

[אהרן2]

כלומר
בכל מקום שמתחיל שינוי שמסומן ב"עקוב אחר שינוים".
מכירים?
תודה מראש!

 

[moishy]

נתחיל עם דבר שכלל לא ביקשת אבל אולי יועיל לך או לאחרים, סטטיסטיקה של עקוב אחר שינויים:

Sub TrackChangeStats()
    Dim lngInsertsWords As Long
    Dim lngInsertsChar As Long
    Dim lngDeletesWords As Long
    Dim lngDeletesChar As Long
    Dim strTemp As String
    Dim objRevision As Revision

    lngInsertsWords = 0
    lngInsertsChar = 0
    lngDeletesWords = 0
    lngDeletesChar = 0
    For Each objRevision In ActiveDocument.Revisions
        Select Case objRevision.Type
            Case wdRevisionInsert
                lngInsertsChar = lngInsertsChar + Len(objRevision.Range.Text)
                lngInsertsWords = lngInsertsWords + objRevision.Range.Words.Count
            Case wdRevisionDelete
                lngDeletesChar = lngDeletesChar + Len(objRevision.Range.Text)
                lngDeletesWords = lngDeletesWords + objRevision.Range.Words.Count
        End Select
    Next objRevision

    strTemp = "הוספות" & vbCrLf
    strTemp = strTemp & "    מילים: " & lngInsertsWords & vbCrLf
    strTemp = strTemp & "    תווים: " & lngInsertsChar & vbCrLf
    strTemp = strTemp & "מחיקות" & vbCrLf
    strTemp = strTemp & "    מילים: " & lngDeletesWords & vbCrLf
    strTemp = strTemp & "    תווים: " & lngDeletesChar & vbCrLf
    MsgBox strTemp, vbMsgBoxRight + vbMsgBoxRtlReading
End Sub

 

[moishy]

וכעת לבקשתך (כמעט לפי דרישותיך):

Sub MarkChangeStats()
    Dim objRevision As Revision
    Dim i As Long
    Selection.HomeKey Unit:=wdStory
    For Each objRevision In ActiveDocument.Revisions
        i = i + 1
        With objRevision.Range
            If i Mod 2 = 0 Then
                .Collapse Direction:=wdCollapseStart
                .Select
                .Move Unit:=wdWord, Count:=objRevision.Range.Words.Count
                .Select
                ActiveDocument.TrackRevisions = False
                Selection.TypeText "@@@@"
                ActiveDocument.TrackRevisions = True
            End If
        End With
    Next objRevision
End Sub

 

[אהרן2]

תודה!!!

אפשר לבקש גם סימון שונה לפני?
(נסיתי להבין את הקוד בשביל לנסות לבד ולא הצלחתי)

 

[אהרן2]

תודה!!!

אפשר לבקש גם סימון שונה לפני?
(נסיתי להבין את הקוד בשביל לנסות לבד ולא הצלחתי)

 

[עיטורים פלוס]

הוא לא מכניס סימון בכל המקומות שהיה שינוי...
והאם ניתן שיוסיף לפני השינוי ואחרי השינוי?

 

[moishy]

תודה!!!

אפשר לבקש גם סימון שונה לפני?
(נסיתי להבין את הקוד בשביל לנסות לבד ולא הצלחתי)

ניסיתי אבל בינתיים לא הצלחתי.

 

[moishy]

הוא לא מכניס סימון בכל המקומות שהיה שינוי...
והאם ניתן שיוסיף לפני השינוי ואחרי השינוי?

איפה הוא לא מצליח?

 

[צורת הדף]

Sub MarkChangeStats()
With ActiveDocument
    For i = 1 To .Revisions.Count
        If .Revisions(i).Type = wdRevisionInsert Then
         .Revisions(i).Range.InsertBefore "#": .Revisions(i).Range.InsertAfter "$"
         ElseIf .Revisions(i).Type = wdRevisionDelete Then
         .Revisions(i).Range.InsertBefore "%": .Revisions(i).Range.InsertAfter "&"
        End If
    Next i
End With
End Sub

 

[אהרן2]

Sub MarkChangeStats()
With ActiveDocument
    For i = 1 To .Revisions.Count
        If .Revisions(i).Type = wdRevisionInsert Then
         .Revisions(i).Range.InsertBefore "#": .Revisions(i).Range.InsertAfter "$"
         ElseIf .Revisions(i).Type = wdRevisionDelete Then
         .Revisions(i).Range.InsertBefore "%": .Revisions(i).Range.InsertAfter "&"
        End If
    Next i
End With
End Sub

לא טוב
לא השארת משהו חסר
תודה תודה לשניכם!

 

[בר בי רב]

נתחיל עם דבר שכלל לא ביקשת אבל אולי יועיל לך או לאחרים, סטטיסטיקה של עקוב אחר שינויים:

Sub TrackChangeStats()
    Dim lngInsertsWords As Long
    Dim lngInsertsChar As Long
    Dim lngDeletesWords As Long
    Dim lngDeletesChar As Long
    Dim strTemp As String
    Dim objRevision As Revision

    lngInsertsWords = 0
    lngInsertsChar = 0
    lngDeletesWords = 0
    lngDeletesChar = 0
    For Each objRevision In ActiveDocument.Revisions
        Select Case objRevision.Type
            Case wdRevisionInsert
                lngInsertsChar = lngInsertsChar + Len(objRevision.Range.Text)
                lngInsertsWords = lngInsertsWords + objRevision.Range.Words.Count
            Case wdRevisionDelete
                lngDeletesChar = lngDeletesChar + Len(objRevision.Range.Text)
                lngDeletesWords = lngDeletesWords + objRevision.Range.Words.Count
        End Select
    Next objRevision

    strTemp = "הוספות" & vbCrLf
    strTemp = strTemp & "    מילים: " & lngInsertsWords & vbCrLf
    strTemp = strTemp & "    תווים: " & lngInsertsChar & vbCrLf
    strTemp = strTemp & "מחיקות" & vbCrLf
    strTemp = strTemp & "    מילים: " & lngDeletesWords & vbCrLf
    strTemp = strTemp & "    תווים: " & lngDeletesChar & vbCrLf
    MsgBox strTemp, vbMsgBoxRight + vbMsgBoxRtlReading
End Sub

הוא עושה סימני שאלה
מה אפשר לשנות?

 

[בר בי רב]

שוב ניסיתי להתקין את המקרו מחדש ונעלם הבאג, ויהי לפלא!

 

[moishy]

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

 

[בר בי רב]

Sub MarkChangeStats()
With ActiveDocument
    For i = 1 To .Revisions.Count
        If .Revisions(i).Type = wdRevisionInsert Then
         .Revisions(i).Range.InsertBefore "#": .Revisions(i).Range.InsertAfter "$"
         ElseIf .Revisions(i).Type = wdRevisionDelete Then
         .Revisions(i).Range.InsertBefore "%": .Revisions(i).Range.InsertAfter "&"
        End If
    Next i
End With
End Sub

אצלי יוצא שיש סימון %& לפני כל מחיקה ואחרי המחיקה אין כלום