Suchen nach Änderungen nach Editor (Microsoft Word)

Private Sub UserForm1_Initialize()

Dim oRevision As Revision     Dim bExists As Boolean

bExists = False

' Go to beginning of document     Selection.HomeKey Unit:=wdStory

' Loop through revisions and add authors     For Each oRevision In ActiveDocument.Revisions         If Me.cboAuthor.ListCount > 0 Then             For i = 1 To Me.cboAuthor.ListCount                 If Me.cboAuthor.List(i - 1) = oRevision.Author Then                     bExists = True                 End If             Next i

' If it doesn't already exist, add the author to list             If Not bExists Then                 Me.cboAuthor.AddItem oRevision.Author             End If

bExists = False         Else             ' Add first Author to the list             Me.cboAuthor.AddItem oRevision.Author         End If     Next oRevision End Sub

Private Sub cmdExit_Click()

Unload Me End Sub

Private Sub cmdFindNext_Click()



Dim iStart As Integer     Dim iEnd As Integer     Dim myRange As Range     Dim iRevisions As Integer     Dim iResponse As Integer     Dim bAuthorFound As Boolean

' Collapse the Selection so that we don't include selected text     Selection.Collapse wdCollapseEnd     Selection.MoveRight wdCharacter, 2

' Get the Range start and end positions     iStart = Selection.Range.Start     iEnd = ActiveDocument.Content.End     Set myRange = ActiveDocument.Range(Start:=iStart, End:=iEnd)



' Count total number of revisions within range     iRevisions = myRange.Revisions.Count

If iRevisions > 0 Then         ' Loop through all revisions in the range          ' selecting first one found         For i = 1 To iRevisions             If myRange.Revisions(i).Author = Me.cboAuthor.Text Then                 myRange.Revisions(i).Range.Select                 bAuthorFound = True                 Exit For             Else                 bAuthorFound = False             End If         Next i     End If

If Not bAuthorFound Then         ' Ask if they would like to start from the beginning         iResponse = MsgBox("Search from beginning?", vbYesNo, "Find Author")

If iResponse = vbYes Then             ' Go to top of document             Selection.HomeKey Unit:=wdStory             cmdFindNext_Click         Else             ' Exit             Unload Me         End If     End If End Sub

Option Explicit

Private Sub ShowAuthorAndRevisions()

Dim sRevision As String     Dim oRev As Revision     Dim oDoc As Document     Dim oRng As Range

For Each oRev In ActiveDocument.Revisions         With oRev             sRevision = sRevision & .Author & vbTab _               & .Type & vbTab & .Range.Text & vbCrLf         End With     Next oRev

' Open a new document     Set oDoc = Documents.Add     With oDoc         .Range.InsertAfter sRevision         ' Convert the revisions to a table         .Range.ConvertToTable Separator:=wdSeparateByTabs         With .Tables(1)

' Sort the table by the author (i.e., the first column)

.Range.Sort             ' Add a new row to the beginning of the table             .Range.Rows.Add BeforeRow:=.Range.Rows(1)

With .Rows(1)

' insert column descriptions                 .Cells(1).Range.Text = "Author"

.Cells(2).Range.Text = "Revision Type"

.Cells(3).Range.Text = "Revision"

End With         End With         ' insert a paragraph mark above the table         Selection.SplitTable         ' Insert a legend to make reading the revision type easier         .Range.InsertBefore "Revision Type Legend:" & vbCrLf & _             "No Revision = 0 " & vbCrLf & _             "Revision Insert = 1 " & vbCrLf & _             "Revision Delete = 2 " & vbCrLf & _             "Revision Property = 3 " & vbCrLf & _             "Revision Paragraph Number = 4 " & vbCrLf & _             "Revision Display Field = 5 " & vbCrLf & _             "Revision Reconcile = 6 " & vbCrLf & _             "Revision Conflict = 7 " & vbCrLf & _             "Revision Style = 8 " & vbCrLf & _             "Revision Replace = 9 " & vbCrLf     End With End Sub