![]() |
|
![]() |
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
![]()
It seems that Usenet/Google Groups is a wasteland now. Glad I found this site.
I have a macro that searches through text for non-Word comments (i.e., text that's bold and surrounded by square brackets) and then converts them into Word comments. However, it inserts the comments as another user by changing the name and initials in the options and then changes them back at the end of the macro. Here's what's weird. It's been working fine in both Word 2007 and 2013 for more than a year. All of a sudden, it won't work in 2013; that is, it moves the comments to Word comments, but the comments don't appear to be from the other user, they appear to be from me. But the new comments also don't match my other comments; for example, my original comments are in red balloons, but the converted ones are in blue balloons. I first thought it was just something about the file, but it's happening with all files. And when I step through the macro in the VBA editor, the statements changing the names and initials appear to contain the right info (I'm hovering the mouse over the variable name), but it doesn't get used when inserting the comments. Any ideas? Here's the macro (and yes, I know it could be tighter, but it works--or did [and I also know that the Selection object is somewhat frowned upon, but again--it works]): Code:
Sub TextToComments() On Error Resume Next Dim myQtext, MyString, myUsername, myUserinitials As String myUsername = Application.UserName myUserinitials = Application.UserInitials Application.UserName = "JSmith" Application.UserInitials = "JS" Application.ScreenUpdating = False If ActiveDocument.TrackRevisions = True Then With ActiveDocument .TrackRevisions = False End With End If Selection.WholeStory Selection.Paragraphs.LineSpacingRule = wdLineSpaceSingle Selection.Collapse Direction:=wdCollapseStart Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Font.Bold = True With Selection.Find .Text = "(\[*\])" .Forward = True .Wrap = wdFindStop .MatchCase = False .MatchWildcards = True End With Selection.Find.Execute MyString = Selection.Text myQtext = Mid(MyString, 2, Len(MyString) - 2) 'strip off brackets If Left(myQtext, 3) <> "TS:" Then 'keep comments to typesetter Selection.Delete Selection.Comments.Add Range:=Selection.Range With Selection .Font.Bold = False .TypeText Text:=myQtext End With ActiveWindow.ActivePane.Close Else myQtext = "" Selection.Collapse Direction:=wdCollapseEnd ActiveWindow.ActivePane.Close End If Do While Selection.Find.Found = True Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Font.Bold = True With Selection.Find .Text = "(\[*\])" .Forward = True .Wrap = wdFindStop .MatchCase = False .MatchWildcards = True End With Selection.Find.Execute If Selection.Find.Found = False Then GoTo Reset MyString = Selection.Text myQtext = Mid(MyString, 2, Len(MyString) - 2) If Left(myQtext, 3) <> "TS:" Then Selection.Delete Selection.Comments.Add Range:=Selection.Range With Selection .Font.Bold = False .TypeText Text:=myQtext End With ActiveWindow.ActivePane.Close Else myQtext = "" Selection.Collapse Direction:=wdCollapseEnd ActiveWindow.ActivePane.Close End If Loop Reset: Selection.WholeStory With Selection.ParagraphFormat .SpaceBefore = 0 .SpaceBeforeAuto = False .SpaceAfter = 6 .SpaceAfterAuto = False .LineSpacingRule = wdLineSpaceSingle End With Selection.Collapse Direction:=wdCollapseStart Selection.HomeKey Unit:=wdStory Application.UserName = myUsername Application.UserInitials = myUserinitials With Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = "" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Highlight = wdUndefined Selection.Find.Replacement.Highlight = wdUndefined Application.ScreenUpdating = True End Sub |
#2
|
||||
|
||||
![]()
Word 2013 ignores the username setting in Options, but you can work around it. Add the following loop where indicated by the existing code:
Code:
If Val(Application.Version) > 14 Then Dim oComment As Comment For Each oComment In ActiveDocument.Comments oComment.Author = Application.UserName Next oComment End If Application.UserName = myUsername Application.UserInitials = myUserinitials
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
![]()
Two questions:
1) If Word 2013 ignores that setting, then why has the macro worked for a year or more? That doesn't make any sense. Is this a new behavior, some kind of change related to an Office update? 2) Changing all the comments defeats the purpose of the macro. Would it be possible to incorporate oComment.Author = Application.UserNameinto the existing loop? That is, to specify the author of the comment when it is actually created? Thanks. |
#4
|
||||
|
||||
![]()
I don't use Word 2013 to do real work, as I much prefer 2010. So I cannot tell you whether it is a new problem or an established one. I can simply tell you that it is a known problem and that the same occurs here. If the behaviour has changed, it is probably attributable to an update somewhere along the line.
You can attribute the comments in real time. Declare the variable Code:
Dim oComment as Comment Code:
Selection.Comments.Add Range:=Selection.Range Code:
Set oComment = Selection.Comments.Add(Range:=Selection.Range) If Val(Application.Version) > 14 Then oComment.Author = Application.UserName End If Code:
Sub TextToComments() Dim oDoc As Document Dim oRng As Range Dim MyString As String Dim myUsername As String Dim myUserinitials As String Dim oComment As Comment myUsername = Application.UserName myUserinitials = Application.UserInitials Application.UserName = "JSmith" Application.UserInitials = "JS" Application.ScreenUpdating = False Set oDoc = ActiveDocument oDoc.TrackRevisions = False Set oRng = oDoc.Range oRng.Paragraphs.LineSpacingRule = wdLineSpaceSingle With oRng.ParagraphFormat .SpaceBefore = 0 .SpaceBeforeAuto = False .SpaceAfter = 6 .SpaceAfterAuto = False .LineSpacingRule = wdLineSpaceSingle End With With oRng.Find Do While .Execute(FindText:="(\[*\])", MatchWildcards:=True) MyString = oRng.Text MyString = Mid(MyString, 2, Len(MyString) - 2) If Not Left(MyString, 3) = "TS:" Then MyString = Mid(MyString, InStr(1, MyString, ":") + 2) oRng.Text = MyString Set oComment = oDoc.Comments.Add(oRng, MyString) If Val(Application.Version) > 14 Then oComment.Author = Application.UserName End If oRng.Font.Bold = False End If oRng.Collapse 0 Loop End With oRng.Collapse 1 oRng.Select Application.ScreenUpdating = True Application.UserName = myUsername Application.UserInitials = myUserinitials lbl_Exit: Set oDoc = Nothing Set oRng = Nothing Set oComment = Nothing Exit Sub End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#5
|
|||
|
|||
![]()
There are a number of problems with that:
1) It doesn't find only bold text, and I don't know how to add that to Do While .Execute(FindText:="(\[*\])", MatchWildcards:=True)I tried adding ", Format:=Bold" but that didn't work. It's very hard to find documentation of all the arguments in all the different formats that one can use. Can you recommend a source (online or in print)? 2) It strips off the first character of the comment text in addition to the brackets. The comments don't have a prefix followed by ":" but ":" is a valid character for the text of the comment. That is, the form is [This is a comment; it can have internal punctuation: like this.]I can figure that out. 3) It doesn't delete the text that's moved to the comment. I can figure that out, too. I don't mean to sound ungrateful. ![]() |
#6
|
|||
|
|||
![]()
I tried
Code:
With oRng.Find With oDoc.Content.Find .Font.Bold = True End With Do While .Execute(FindText:="(\[*\])", MatchWildcards:=True, _ Format:=True) ![]() |
#7
|
|||
|
|||
![]()
Ah:
Code:
With oRng.Find With .Font .Bold = True End With Do While .Execute(FindText:="(\[*\])", MatchWildcards:=True, _ Format:=True) |
#8
|
|||
|
|||
![]()
OK, I got it all to work. I was able to remove a lot of stuff (commented out here):
Code:
Sub TextToComments() Dim oDoc As Document Dim oRng As Range Dim MyString As String 'Dim myUsername As String 'Dim myUserinitials As String Dim oComment As Comment 'myUsername = Application.UserName 'myUserinitials = Application.UserInitials 'Application.UserName = "JSmith" 'Application.UserInitials = "JS" Application.ScreenUpdating = False Set oDoc = ActiveDocument oDoc.TrackRevisions = False Set oRng = oDoc.Range oRng.Paragraphs.LineSpacingRule = wdLineSpaceSingle With oRng.ParagraphFormat .SpaceBefore = 0 .SpaceBeforeAuto = False .SpaceAfter = 6 .SpaceAfterAuto = False .LineSpacingRule = wdLineSpaceSingle End With With oRng.Find With .Font .Bold = True End With Do While .Execute(FindText:="(\[*\])", MatchWildcards:=True, _ Format:=True) MyString = oRng.Text MyString = Mid(MyString, 2, Len(MyString) - 2) If Not Left(MyString, 3) = "TS:" Then 'MyString = Mid(MyString, InStr(1, MyString, ":") + 2) oRng.Text = MyString oRng.Delete Set oComment = oDoc.Comments.Add(oRng, MyString) oComment.Author = "MNathan" 'If Val(Application.Version) > 14 Then ' oComment.Author = Application.UserName 'End If oRng.Font.Bold = False End If oRng.Collapse 0 Loop End With oRng.Collapse 1 oRng.Select Application.ScreenUpdating = True 'Application.UserName = myUsername 'Application.UserInitials = myUserinitials lbl_Exit: Set oDoc = Nothing Set oRng = Nothing Set oComment = Nothing Exit Sub End Sub Thanks for all your help. My next project is creating a macro to change a text highlighted in one color to another color, but I want the user to specify both of the colors. It will be my first crack at a userform, I think. Exciting! Actually, that leads me to a Final final question re: userforms: Is Word's highlight color button (with the little squares of color) available to use in userforms? That would simplify things... maybe. Thanks again. |
#9
|
||||
|
||||
![]()
The elusive syntax you were looking for is
Code:
With oRng.Find .Font.Bold = True 'etc ![]() I have to say that while your code works in Word 2013, it now doesn't work in 2007 or 2010. For those versions you would need to set the username and initials as before, with the option for 2013 (or use your old macro). You don't really need the screen control commands in the macro. You cannot add the highlight dialog to a userform, but you can emulate it with a group of small command buttons coloured to match the highlight colour selection. You will find ColorCop very useful when identifying colours for use in userforms.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#10
|
|||
|
|||
![]()
I found that if I add "oComment.Initial = "MN" here:
Code:
Set oComment = oDoc.Comments.Add(oRng, MyString) oComment.Author = "MNathan" oComment.Initial = "MN" I will say one thing: the new version is A LOT faster than the old one. Thanks again. |
#11
|
||||
|
||||
![]()
Good catch - I had overlooked that.
The speed increase is primarily the result of using ranges, which don't require the area to be selected in order to process it. All that flitting around in the document adds to the processing time.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
piper7971 | Excel | 10 | 07-06-2015 02:09 PM |
![]() |
captainship | PowerPoint | 1 | 04-16-2015 09:35 AM |
![]() |
samhdc | Word | 1 | 03-30-2012 04:56 AM |
![]() |
Sachelis | Word | 2 | 01-28-2011 08:50 AM |
Saving a Word 2007 document as a PDF fails | dcabrames | Word | 20 | 01-21-2011 03:07 PM |