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
לוח לימודים
מסלולי לימוד שאפשר לההצטרף
אליהם ממש עכשיו:
8.05
ל' ניסן
פתיחת מסלול
אוטומציות עסקיות, בוטים והטמעת מערכות מידע
מלגות גבוהות!
9.05
א' אייר
הנחת ענק!
ירושלמי?
יש לנו מלגה מטורפת עבורך! קורס במימון כמעט מלא!!
ההרשמה בעיצומה
28.05
כ' אייר
פתיחת מסלול מורחב:
פיתוח ובניית אתרים
מלגות גבוהות!
2.06
כ"ה אייר
פתיחת מסלול
קורס עריכת וידאו
מלגות והנחות משמעותיות!
24.06
י"ח סיוון
פתיחת מסלול
מאסטר בשיווק דיגיטלי
מלגות גבוהות!
27.06
כ"א סיוון
פתיחת מסלול
עיצוב ואדריכלות פנים
מלגות גבוהות!
27.06
כ"א סיוון
השקה חגיגית!
עיצוב גרפי ודיגיטל - בסילבוס חדש ומטורף!
מלגות גבוהות!
7.05
כ"ט ניסן
#רקבפרוג
הרצאה מרתקת:
מלחמה מבעד לעדשה
עם אילן לורנצי
שיתוף מטלטל ומיוחד על צילומים בזמן מלחמה ותיעודים יותאי דופן זווית יוצאת דופן מתוך עזה והעוטף ועד הצפון
לתלמידים ובוגרים בלבד!
תהילים פרק קלב
א שִׁיר הַמַּעֲלוֹת זְכוֹר יְהוָה לְדָוִד אֵת כָּל עֻנּוֹתוֹ:ב אֲשֶׁר נִשְׁבַּע לַיהוָה נָדַר לַאֲבִיר יַעֲקֹב:ג אִם אָבֹא בְּאֹהֶל בֵּיתִי אִם אֶעֱלֶה עַל עֶרֶשׂ יְצוּעָי:ד אִם אֶתֵּן שְׁנַת לְעֵינָי לְעַפְעַפַּי תְּנוּמָה:ה עַד אֶמְצָא מָקוֹם לַיהוָה מִשְׁכָּנוֹת לַאֲבִיר יַעֲקֹב:ו הִנֵּה שְׁמַעֲנוּהָ בְאֶפְרָתָה מְצָאנוּהָ בִּשְׂדֵי יָעַר:ז נָבוֹאָה לְמִשְׁכְּנוֹתָיו נִשְׁתַּחֲוֶה לַהֲדֹם רַגְלָיו:ח קוּמָה יְהוָה לִמְנוּחָתֶךָ אַתָּה וַאֲרוֹן עֻזֶּךָ:ט כֹּהֲנֶיךָ יִלְבְּשׁוּ צֶדֶק וַחֲסִידֶיךָ יְרַנֵּנוּ:י בַּעֲבוּר דָּוִד עַבְדֶּךָ אַל תָּשֵׁב פְּנֵי מְשִׁיחֶךָ:יא נִשְׁבַּע יְהוָה לְדָוִד אֱמֶת לֹא יָשׁוּב מִמֶּנָּה מִפְּרִי בִטְנְךָ אָשִׁית לְכִסֵּא לָךְ:יב אִם יִשְׁמְרוּ בָנֶיךָ בְּרִיתִי וְעֵדֹתִי זוֹ אֲלַמְּדֵם גַּם בְּנֵיהֶם עֲדֵי עַד יֵשְׁבוּ לְכִסֵּא לָךְ:יג כִּי בָחַר יְהוָה בְּצִיּוֹן אִוָּהּ לְמוֹשָׁב לוֹ:יד זֹאת מְנוּחָתִי עֲדֵי עַד פֹּה אֵשֵׁב כִּי אִוִּתִיהָ:טו צֵידָהּ בָּרֵךְ אֲבָרֵךְ אֶבְיוֹנֶיהָ אַשְׂבִּיעַ לָחֶם:טז וְכֹהֲנֶיהָ אַלְבִּישׁ יֶשַׁע וַחֲסִידֶיהָ רַנֵּן יְרַנֵּנוּ:יז שָׁם אַצְמִיחַ קֶרֶן לְדָוִד עָרַכְתִּי נֵר לִמְשִׁיחִי:יח אוֹיְבָיו אַלְבִּישׁ בֹּשֶׁת וְעָלָיו יָצִיץ נִזְרוֹ: