Microsoft Office Forums - View Single Post - Macro now fails in Word 2013 after working for more than a year; still works in 2007

cyraxote · 09-03-2015, 07:52 AM

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

Any thoughts? Thanks!