Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub CommentsToCells()
- Dim xlapp As Object
- Dim xlbook As Object
- Dim xlsheet As Object
- Dim i As Long
- Set xlapp = GetObject(, "Excel.Application")
- If Err Then
- Set xlapp = CreateObject("Excel.Application")
- End If
- On Error GoTo 0
- Set xlbook = xlapp.Workbooks.Add
- Set xlsheet = xlbook.Worksheets(1)
- With xlsheet.Range("A1")
- .Offset(0, 0) = "Comment #"
- .Offset(0, 1) = "Author"
- .Offset(0, 2) = "Comment"
- .Offset(0, 3) = "Date"
- End With
- With ActiveDocument
- For i = 1 To .Comments.Count
- xlsheet.Range("A1").Offset(i, 0) = i
- xlsheet.Range("B1").Offset(i, 0) = .Comments(i).Author
- xlsheet.Range("C1").Offset(i, 0) = .Comments(i).Range.Text
- xlsheet.Range("D1").Offset(i, 0) = .Comments(i).Scope.Text
- xlsheet.Range("E1").Offset(i, 0) = .Comments(i).Date
- Next i
- End With
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement