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
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;1663664:תודה!!!
אפשר לבקש גם סימון שונה לפני?
(נסיתי להבין את הקוד בשביל לנסות לבד ולא הצלחתי)
איפה הוא לא מצליח?נכתב ע"י גלאט;1663816:הוא לא מכניס סימון בכל המקומות שהיה שינוי...
והאם ניתן שיוסיף לפני השינוי ואחרי השינוי?
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
נכתב ע"י קרש;1664046:קוד: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
אצלי יוצא שיש סימון %& לפני כל מחיקה ואחרי המחיקה אין כלוםקוד: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
אל תחמיצו!!!
מנוי פרימיום באתר פרוג, יקפיץ את המוניטין שלך לקהל גדול שאסור לך להחמיץ!
ועכשיו בהזדמנות, מבצע פסח 10% הנחה ברכישת מנוי שנתי!
לוח לימודים
מסלולי לימוד שאפשר לההצטרף
אליהם ממש עכשיו:
2.04
כ"ג אדר ב'
השקה חגיגית
חדש בפרוג
קורס חדשנות AI ובינה מלאכותית
14 שיעורים מפוצצים תוכן על כלי הAI השונים ליצירת תמונות וויז'ואל, עריכת וידאו ומושן, כתיבה ורעיונות, אפיון ועיצוב אתרים ועוד המון!
ההרשמה נפתחה!
20.03
י' אדר ב'
פתיחת מסלול
עיצוב ואדריכלות פנים
מלגות גבוהות!
26.03
טז' אדר ב'
פתיחת מסלול
מאסטר בשיווק דיגיטלי
מלגות גבוהות!
8.05
ל' ניסן
פתיחת מסלול
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
מלגות גבוהות!
9.05
א' אייר
ירושלמי?
יש לנו מלגה מטורפת עבורך! קורס במימון כמעט מלא!!
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
ההרשמה בעיצומה
28.05
כ' אייר
פתיחת מסלול מורחב:
פיתוח ובניית אתרים
מלגות גבוהות!
תהילים פרק קכג
א שִׁיר הַמַּעֲלוֹת אֵלֶיךָ נָשָׂאתִי אֶת עֵינַי הַיֹּשְׁבִי בַּשָּׁמָיִם:ב הִנֵּה כְעֵינֵי עֲבָדִים אֶל יַד אֲדוֹנֵיהֶם כְּעֵינֵי שִׁפְחָה אֶל יַד גְּבִרְתָּהּ כֵּן עֵינֵינוּ אֶל יְהוָה אֱלֹהֵינוּ עַד שֶׁיְּחָנֵּנוּ:ג חָנֵּנוּ יְהוָה חָנֵּנוּ כִּי רַב שָׂבַעְנוּ בוּז:ד רַבַּת שָׂבְעָה לָּהּ נַפְשֵׁנוּ הַלַּעַג הַשַּׁאֲנַנִּים הַבּוּז לִגְאֵיוֹנִים: