View Single Post
 
Old 05-15-2021, 01:12 AM
Guessed's Avatar
Guessed Guessed is offline Windows 10 Office 2016
Expert
 
Join Date: Mar 2010
Location: Canberra/Melbourne Australia
Posts: 4,176
Guessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant futureGuessed has a brilliant future
Default

I think Paul has solved the issue with the local formatting but there was a mix up with the r and n variables. His code doesn't bring across the paragraph style either. So using his lead, try this variant
Code:
Sub AnalyseComments()
  Dim oDoc As Document, oNewDoc As Document, oTable As Table
  Dim aCom As Comment, nCount As Long, n As Long, aRng As Range
  
  Set oDoc = ActiveDocument
  nCount = ActiveDocument.Comments.Count
  
  'Create a new document for the comments
  Set oNewDoc = Documents.Add(Template:=ActiveDocument.FullName)
  oNewDoc.Range.Delete
  
  'Insert a 4-column table for the comments
  With oNewDoc
    .Content = ""
    Set oTable = .Tables.Add(Range:=Selection.Range, NumRows:=nCount + 1, NumColumns:=4)
  End With
  
  With oTable.Rows(1)
    .Range.Font.Bold = True
    .Cells(1).Range.Text = "Page"
    .Cells(2).Range.Text = "Comment scope"
    .Cells(3).Range.Text = "Comment text"
    .Cells(4).Range.Text = "Author"
  End With
  
  'Get info from each comment from oDoc and insert in table
  For n = 1 To nCount
    Set aCom = oDoc.Comments(n)
    With oTable.Rows(n + 1)
      .Cells(1).Range.Text = aCom.Scope.Information(wdActiveEndPageNumber)      'Page number
      Set aRng = .Cells(2).Range
      With aRng
        .Style = aCom.Scope.Paragraphs(1).Style
        .End = .End - 1
        .FormattedText = aCom.Scope.FormattedText
      End With
      .Cells(3).Range.Text = aCom.Range.Text    'The comment itself
      .Cells(4).Range.Text = aCom.Author    'The comment author
    End With
  Next n
  
  oNewDoc.Activate
  MsgBox "Finished creating comments document."
  
  Set oDoc = Nothing
  Set oNewDoc = Nothing
  Set oTable = Nothing

End Sub
__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia
Reply With Quote