Hallo,
ich würde gerne das untenstehende Word-Makro, das ich gefunden habe, auf meine Bedürfnisse anpassen. Im original exportiert es die Ergebnisse in 5 Spalten. Die Anpassung auf 6 Spalten habe ich schon hinbekommen. Da ich aber leider gar keine Kenntnisse in VBA verfüge, bekomme ich die Befüllung der zweiten Spalte nicht hin. Ich möchte die Überschrit, unter der der jeweilige Kommentar verfasst wurde, in die 2. Spalte schreiben. Ich vermute, dass ich irgendwie über Range eine rückwärtsgerichtete Suche durchführen muss. Aber wie gesagt: Ich hab gar keinen Plan :D Vllt. kann mir ein etwas versierterer, netter Mensch unter die Arme greifen :) Tausend Dank!
_________________________________
Public Sub ExtractCommentsToNewDoc()
Dim oDoc As Document
Dim oNewDoc As Document
Dim oTable As Table
Dim nCount As Long
Dim n As Long
Dim Title As String
Title = "Extract All Comments to New Document"
Set oDoc = ActiveDocument
nCount = ActiveDocument.Comments.Count
If nCount = 0 Then
MsgBox "The active document contains no comments.", vbOKOnly, Title
GoTo ExitHere
Else
If MsgBox("Do you want to extract all comments to a new document?", _
vbYesNo + vbQuestion, Title) <> vbYes Then
GoTo ExitHere
End If
End If
Application.ScreenUpdating = False
Set oNewDoc = Documents.Add
oNewDoc.PageSetup.Orientation = wdOrientLandscape
With oNewDoc
.Content = ""
Set oTable = .Tables.Add _
(Range:=Selection.Range, _
NumRows:=nCount + 1, _
NumColumns:=6)
End With
oNewDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Text = _
"Comments extracted from: " & oDoc.FullName & vbCr & _
"Created by: " & Application.UserName & vbCr & _
"Creation date: " & Format(Date, "MMMM d, yyyy")
With oNewDoc.Styles(wdStyleNormal)
.Font.Name = "Arial"
.Font.Size = 10
.ParagraphFormat.LeftIndent = 0
.ParagraphFormat.SpaceAfter = 6
End With
With oNewDoc.Styles(wdStyleHeader)
.Font.Size = 8
.ParagraphFormat.SpaceAfter = 0
End With
With oTable
.Range.Style = wdStyleNormal
.AllowAutoFit = False
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Columns.PreferredWidthType = wdPreferredWidthPercent
.Columns(1).PreferredWidth = 5
.Columns(2).PreferredWidth = 5
.Columns(3).PreferredWidth = 23
.Columns(4).PreferredWidth = 42
.Columns(5).PreferredWidth = 18
.Columns(6).PreferredWidth = 12
.Rows(1).HeadingFormat = True
End With
With oTable.Rows(1)
.Range.Font.Bold = True
.Cells(1).Range.Text = "Page"
.Cells(2).Range.Text = "EndSection"
.Cells(3).Range.Text = "Comment scope"
.Cells(4).Range.Text = "Comment text"
.Cells(5).Range.Text = "Author"
.Cells(6).Range.Text = "Date"
End With
For n = 1 To nCount
With oTable.Rows(n + 1)
.Cells(1).Range.Text = _
oDoc.Comments(n).Scope.Information(wdActiveEndPageNumber)
<strong>.Cells(2).Range.Text = ?????</strong>
.Cells(3).Range.Text = oDoc.Comments(n).Scope
.Cells(4).Range.Text = oDoc.Comments(n).Range.Text
.Cells(5).Range.Text = oDoc.Comments(n).Author
.Cells(6).Range.Text = Format(oDoc.Comments(n).Date, "dd-MMM-yyyy")
End With
Next n
Application.ScreenUpdating = True
Application.ScreenRefresh
oNewDoc.Activate
MsgBox nCount & " comments found. Finished creating comments document.", vbOKOnly, Title
ExitHere:
Set oDoc = Nothing
Set oNewDoc = Nothing
Set oTable = Nothing
End Sub
Sub applyTableFormat()
End Sub