looking for some solutions? You are welcome.

SOLVED: Looking for code review and critique before showing superiors my Word macro

MACC:

I work in the training department of a captioning agency, and spend a lot of time grading trainee's dictation transcripts. We receive the transcripts of trainee's dictation of test audios and then compare them with MS Word to the original transcript, highlighting incorrect words yellow, omitted words blue, and added words green. At the end we itemize the number of errors in each category, and then calculate the accuracy. I made a short macro that, once I've highlighted the errors appropriately, will count and print the itemized error counts, total errors, and accuracy percentage along with the grader's name, and finally copy the score to clipboard. In the original that I'm comparing to I've bolded the transcript and italicized the total word count that's printed at the end so the macro can identify them. We use Office 2016 on Windows 7, just in case that's relevant. I have some experience programming but am new to VBA, and would really like to have somebody with more experience look over my code to see what I can correct and improve, with syntax and function, before I show it to my supervisors. So far it works just as I would like it to but I'm sure it could be improved and made to be more efficient and reliable. I've also included a sample of a graded transcript to give a clearer picture of what I'm working with. Thanks in advance for any help you are able to provide.

Sub CountErrorsByColor()
    Dim objDoc As Document
    Dim objWord As Object
    Dim nHighlightedYellow As Long
    Dim nHighlightedBlue As Long
    Dim nHighlightedGreen As Long
    Dim nHighlightedTotal As Long
    Dim wTotal As Long
    Dim oRng As Word.Range
    Dim mystring As New DataObject
    Application.ScreenUpdating = False

'Count errors by highlight color and total errors.
    Set objDoc = ActiveDocument
    For Each objWord In objDoc.Words
        If objWord.HighlightColorIndex = wdYellow And objWord.Font.Bold Then
            nHighlightedYellow = nHighlightedYellow + 1: nHighlightedTotal = nHighlightedTotal + 1
        ElseIf objWord.HighlightColorIndex = wdTurquoise Then
            nHighlightedBlue = nHighlightedBlue + 1: nHighlightedTotal = nHighlightedTotal + 1
        ElseIf objWord.HighlightColorIndex = wdBrightGreen Then
            nHighlightedGreen = nHighlightedGreen + 1: nHighlightedTotal = nHighlightedTotal + 1
        End If
    Next objWord

'Find total word count
    ActiveDocument.Range.Select
        Selection.Find.Font.Italic = True
        With Selection.Find
          .ClearFormatting
          .Font.Italic = True
          .Wrap = wdFindStop
          .Execute
            If .Found = True Then
                italText = Selection.Range.Text
            End If
        End With
    wTotal = Selection.Text
    Application.Selection.EndOf

'Calculate and format score
    score = (wTotal - nHighlightedTotal) / wTotal
    formattedScore = Format(score, "Percent")
    pasteScore = Format(score * 100, "Standard")

'Print error counts, score, and name
    Set oRng = Selection.Range
    With oRng
        .Text = "Incorrect: " & nHighlightedYellow
        .HighlightColorIndex = wdYellow
        .Font.Bold = True
        .Collapse wdCollapseEnd
        .Select
        .Text = vbNewLine & _
        "Omitted: " & nHighlightedBlue
        .HighlightColorIndex = wdTurquoise
        .Font.Bold = True
        .Collapse wdCollapseEnd
        .Select
        .Text = vbNewLine & _
        "Added: " & nHighlightedGreen
        .HighlightColorIndex = wdBrightGreen
        .Font.Bold = True
        .Collapse wdCollapseEnd
        .Select
        .Text = vbNewLine & _
        "Total: " & nHighlightedTotal
       .HighlightColorIndex = wdNoHighlight
        .Font.Bold = True
        .Collapse wdCollapseEnd
        .Select
        .Text = vbNewLine & _
        "Score: " & formattedScore
        .HighlightColorIndex = wdNoHighlight
        .Font.Bold = True
        .Collapse wdCollapseEnd
        .Select
        .Text = vbNewLine & _
        "Grader's Name"
        .HighlightColorIndex = wdNoHighlight
        .Font.Bold = True
        .Collapse wdCollapseEnd
        .Select
    End With

'Copy score to clipboard
    my_var = pasteScore
    mystring.SetText my_var
    mystring.PutInClipboard

End Sub

Graded Transcript



Posted in S.E.F
via StackOverflow & StackExchange Atomic Web Robots
Share:

No comments:

Recent