#1
|
|||
|
|||
Macro to maintain formatting OR to delete all text (excluding comments)
Hi,
I have been using a Macro for some time that extracts all text in a Word that had been covered/highlighted by a comment, and inserts it into a new, separate Word document. However, the only issue is that the extracted text does not maintain the existing formatting of the original document, i.e. same font, same font size etc.. I'm not quite sure how best to edit my Macro for that function? Code:
Sub AnalyseComments() Dim oDoc As Document Dim oNewDoc As Document Dim oTable As Table Dim nCount As Long Dim n As Long Set oDoc = ActiveDocument nCount = ActiveDocument.Comments.Count 'Create a new document for the comments Set oNewDoc = Documents.Add '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 With oTable.Rows(n + 1) 'Page number .Cells(1).Range.Text = _ oDoc.Comments(n).Scope.Information(wdActiveEndPageNumber) 'The text marked by the comment .Cells(2).Range.Text = oDoc.Comments(n).Scope 'The comment itself .Cells(3).Range.Text = oDoc.Comments(n).Range.Text 'The comment author .Cells(4).Range.Text = oDoc.Comments(n).Author End With Next n oNewDoc.Activate MsgBox "Finished creating comments document." Set oDoc = Nothing Set oNewDoc = Nothing Set oTable = Nothing End Sub I'd be grateful for any advice if anyone is able to help. Last edited by macropod; 05-14-2021 at 09:11 PM. Reason: Added code tags & formatting |
#2
|
||||
|
||||
Firstly, the formatting of text pasted into another document often adapts its look because the style definitions in both docs differs. You can avoid that by creating the new document using the current document. Next you should use Range.FormattedText instead of Range.Text. Then, if you aren't pasting paragraph marks then you probably need to apply the same paragraph style.
When it comes to local formatting, the two red lines 'should' have worked on my machine but they didn't - perhaps you will have more luck with it. Code:
Sub AnalyseComments() Dim oDoc As Document, oNewDoc As Document, oTable As Table Dim aCom As Comment, nCount As Long, n As Long 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 .Cells(2).Range.Style = aCom.Scope.Paragraphs(1).Style 'apply the same paragraph style .Cells(2).Range.FormattedText = aCom.Scope.FormattedText 'The text marked by the comment .Cells(2).Range.Font = aCom.Scope.Font 'this fails even when same attributes over whole range .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 Set aCom = Nothing End Sub
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#3
|
||||
|
||||
Try:
Code:
Sub AnalyseComments() Application.ScreenUpdating = False Dim DocSrc As Document, DocTgt As Document, Tbl As Table, Rng As Range, r As Long Set DocSrc = ActiveDocument 'Create a new document for the comments Set DocTgt = Documents.Add 'Insert a 4-column table for the comments With DocTgt .Content = "" Set Tbl = .Tables.Add(Range:=.Range, NumRows:=DocSrc.Comments.Count + 1, NumColumns:=4) With Tbl With .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 DocSrc and insert in table For r = 1 To .Rows.Count With .Rows(r + 1) 'Page number .Cells(1).Range.Text = DocSrc.Comments(r).Scope.Information(wdActiveEndPageNumber) 'The text marked by the comment Set Rng = .Cells(2).Range With Rng .End = .End - 1 .FormattedText = DocSrc.Comments(r).Scope.FormattedText End With 'The comment itself Set Rng = .Cells(3).Range With Rng .End = .End - 1 .FormattedText = DocSrc.Comments(r).Range.FormattedText End With 'The comment author .Cells(4).Range.Text = DocSrc.Comments(r).Author End With Next End With .Activate End With Set DocSrc = Nothing: Set DocTgt = Nothing: Set Tbl = Nothing: Set Rng = Nothing Application.ScreenUpdating = True MsgBox "Finished creating comments document." End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Hi both,
Thanks. I really appreciate your support. I tried both options, but they didn't seem to work. @Macropod, the debugger flagged an issue at: .Cells(1).Range.Text = DocSrc.Comments(n).Scope.Information(wdActiveEndPa geNumber) |
#5
|
||||
|
||||
Quote:
.Cells(1).Range.Text = _ oDoc.Comments(n).Scope.Information(wdActiveEndPage Number) Code corrected.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
||||
|
||||
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 |
#7
|
|||
|
|||
Hi all,
I want to extend my thanks to you for your assistance. Really appreciated. I made a couple of quick amends to the coding as the debugger didn't quite like a particular line. This was the final code in the end: 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 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 Once again, thank you very much for your expertise and assistance. |
Tags |
macro, vba, word macro |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
VBA macro to change author name in tagged comments, then delete the tags | mjt | Word VBA | 0 | 01-28-2021 08:48 AM |
Macro to highlight and bolden specific text in Word Comments | PCUSER | Word VBA | 1 | 09-22-2020 03:08 PM |
Formula to delete but maintain counts after the maximum has been reached | wheddingsjr | Excel | 2 | 01-03-2018 01:49 PM |
Form won't maintain formatting | SBrant | Word | 0 | 02-10-2011 10:29 AM |
Maintain formatting while copying text from word, and pasting into a webpage. | kdogg121 | Word | 1 | 07-07-2009 02:50 AM |