Attribute VB_Name = "NewMacros" Sub ListeAenderung() 'Pia Bork, August 2013 'http://www.borkpc.de 'zeigt die Liste aller Änderungen eines Dokumentes als Tabelle Dim quellDoc As Document Dim newDoc As Document Dim xtab As Table Dim xrows As Long Dim RevType As Variant RevType = Array("Keine Änderung", "Einfügung", "Löschung", _ "Format Zeichen", "Änderung Absatznummer", "Änderung Feldanzeige", _ "Gelöster Konflikt", "Konflikt", "Änderung Formatvorlage", "Ersetzt", _ "Format Absatz", "Format Tabelle", _ "Format Abschnitt", "Änderung Formatvorlagendefinition", _ "Verschoben von", "Verschoben nach", "Tabellenzellen eingefügt", _ "Tabellenzellen gelöscht", "Tabellenzellen zusammengefügt") Set quellDoc = ActiveDocument Set newDoc = Documents.Add Set xtab = newDoc.Tables.Add(Selection.Range, 1, 5) xrows = 1 With xtab .Cell(1, 1).Range.Text = "Datum" .Cell(1, 2).Range.Text = "Uhrzeit" .Cell(1, 3).Range.Text = "Autor" .Cell(1, 4).Range.Text = "Typ" .Cell(1, 5).Range.Text = "Seite, Zeile" For Each Revision In quellDoc.Revisions .Rows.Add xrows = xrows + 1 .Cell(xrows, 1).Range.Text = Left(Revision.Date, 10) .Cell(xrows, 2).Range.Text = Right(Revision.Date, 8) .Cell(xrows, 3).Range.Text = Revision.Author .Cell(xrows, 4).Range.Text = RevType(Revision.Type) .Cell(xrows, 5).Range.Text = Revision.Range.Information(wdActiveEndAdjustedPageNumber) & ", " & Revision.Range.Information(wdFirstCharacterLineNumber) Next Revision End With With Selection.Tables(1) .Style = "Helle Liste - Akzent 1" .AutoFitBehavior wdAutoFitContent .Rows(1).HeadingFormat = wdToggle End With End Sub