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

gmayor · 09-04-2015, 04:39 AM

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

Change the line:

Code:

Selection.Comments.Add Range:=Selection.Range

to

Code:

Set oComment = Selection.Comments.Add(Range:=Selection.Range)
        If Val(Application.Version) > 14 Then
            oComment.Author = Application.UserName
        End If

If the bracketed text looks like [JS: Duis autem] then the following macro should work to leave 'Duis autem' commented

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

but it will ignore entries like [TS: Duis autem] which I think was the intention. It should be easy enough to modify entries for TS also.