4
\$\begingroup\$

I work in the training department of a captioning agency, where I 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 Microsoft 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 the final output is.

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
\$\endgroup\$

migrated from stackoverflow.com Mar 9 at 9:04

This question came from our site for professional and enthusiast programmers.

  • \$\begingroup\$ Please do not update the code in your question to incorporate feedback from answers, doing so goes against the Question + Answer style of Code Review. This is not a forum where you should keep the most updated version in your question. Please see what you may and may not do after receiving answers. Please consider posting a follow-up question instead, indicated by the repost suggestion in the answer provided. \$\endgroup\$ – Mast Mar 10 at 5:37
  • \$\begingroup\$ My fault, I'll do my best to adhere more closely to the site rules in the future. \$\endgroup\$ – Abernaughty Mar 10 at 6:33
  • \$\begingroup\$ Didn't RubberDuck complain about the usage ofSelection/Select? They can be removed most times, by just concating the expression before.Selectwith the part afterSelection.like' ActiveDocument.Range.Find.Font.Italic = True` Also you should try to sray DRY. Everytime you see repeating code with just minor diffs you should create s loop and a procedure that do tge same with less code. \$\endgroup\$ – ComputerVersteher Mar 10 at 7:48
  • \$\begingroup\$ At the moment code inspection doesn't have any errors/warnings/suggestions/hints for the module, but I see how that would be more efficient that way. I'll definitely look into it. Regarding staying DRY you are totally right. My knowledge of VBA and truthfully programming in general is definitely bottle-necking me, but I'll look to make those sections more efficient. Presumably the font and paragraph formatting in the printScore section would be an example of where that would be most beneficial? \$\endgroup\$ – Abernaughty Mar 10 at 8:36
5
\$\begingroup\$

As this is a code review request, some of my comments may be considered "best practices" by me and not by others (though most of my habits I've picked up from sites and reviews such as this one). Your code is successful already because it accomplishes the task for which you have designed. Most of the improvements I can suggest are in terms of software design and presentation.

  1. It is far less desirable to present a "wall of declarations" at the beginning of a method because it forces the reader to constantly refer back and forth between the logic and the declaration to figure out which variable is declared as what. It also makes it easier to declare a variable and then never use it. So... always declare your variables as close as practical to where they are first used.
  2. Always keep a wary eye out of repetitive-seeming steps or logic. When you find yourself cutting and pasting the same code with some tweaks to perform a nearly identical action, breaking it out into a separate method makes your logic much easier to read, PLUS it isolates your logic in a single location. This way if you have to modify that logic, you only do it once. In your code, you need to count the number of highlighted words of several different colors.

Breaking that out into its own Sub helps to keep the focus on how this is done:

Private Function CountFormattedWords(ByVal checkIndex As WdColorIndex, _
                                     Optional ByRef checkDoc As Document = Nothing) As Long
    '--- counts the number of words in the document highlighted with
    '    the given highlight color index
    Dim thisDoc As Document
    If checkDoc Is Nothing Then
        Set thisDoc = ThisDocument
    Else
        Set thisDoc = checkDoc
    End If

    Dim checkWord As Variant
    For Each checkWord In thisDoc.Words
        If checkWord.HighlightColorIndex = checkIndex Then
            CountFormattedWords = CountFormattedWords + 1
        End If
    Next checkWord
End Function

Notice the Optional ByRef checkDoc As Document = Nothing parameter. This is something I'll throw into the parameter list of a method based on long experience, knowing that I just might want to reuse this sub for a different Document. Clearly you can easily assume you're accessing the local document, but it might not always be the case.

Also, note that I used ThisDocument instead of ActiveDocument. The difference here is important. By specifying ThisDocument here, I'm telling the code to refer to the MS Word document in which the VBA code resides. If I used ActiveDocument, then I would be referring to whichever MS Word document is currently "on top" or actively being viewed/edited by the user. So in the case of this parameter, I'm giving myself the option to default it one way, but use it in a different way if I need to (see below).

So now the beginning of your logic can look like this

    Dim testDoc As Document
    Dim yellowErrors As Long
    Dim blueErrors As Long
    Dim greenErrors As Long
    Dim totalErrors As Long
    Set testDoc = ActiveDocument
    yellowErrors = CountFormattedWords(wdYellow, testDoc)
    blueErrors = CountFormattedWords(wdTurquoise, testDoc)
    greenErrors = CountFormattedWords(wdBrightGreen, testDoc)
    totalErrors = yellowErrors + blueErrors + greenErrors

You can note that here is where I slip in the reference to the ActiveDocument, which overrides the default of my parameter.

  1. Avoid using Select. This is a major point when programming VBA for Excel, but less rigorous when using VBA in MS Word. With all the examples on the webz showing Select, you might find it hard to avoid. Since I started my VBA journey in Excel, I still stick with this rule though. So for using Find on a range to look for your word count, I created a Range variable called wordCount. Initially, you can see the range is set to encompass the entire document. After executing the Find however, this variable collapses to only the found text (in this case the text that is italic). A simple cast/conversion from String to Long gets me the integer word count.

    '--- total word count should be the only text in the document
    '    using Italic format
    Dim wordTotal As Long
    Dim wordCount As Range
    Set wordCount = testDoc.Content
    With wordCount.Find
        .Font.Italic = True
        .Wrap = wdFindStop
        .Execute
        If .Found Then
            wordTotal = CLng(wordCount)
        Else
            '--- do something if we didn't find it
            MsgBox "ERROR! Can't find the Total Words count!"
            Exit Sub
        End If
    End With
    
  2. Your longest section of code is creating/appending the various details of the score to the end of the document. Again, it's pretty repetitive and pretty much the same. So... we have a separate sub to isolate the logic. This logic avoids using Select and simplifies some of what you were doing. Because it's nicely isolated, you can add any additional paragraph formatting you like here (and only do it once!).

    Private Sub AppendScoreDetail(ByVal thisText As String, _
                                  ByVal thisHighlight As WdColorIndex, _
                                  Optional ByRef checkDoc As Document = Nothing)
        Dim thisDoc As Document
        If checkDoc Is Nothing Then
            Set thisDoc = ThisDocument
        Else
            Set thisDoc = checkDoc
        End If
    
        Dim newText As Paragraph
        Set newText = thisDoc.Content.Paragraphs.Add
        With newText.Range
            .Text = thisText
            .Font.Italic = False
            .Font.Underline = False
            .Font.Bold = True
            .Font.Name = "Arial Black"
            .Font.Size = 11
            .HighlightColorIndex = thisHighlight
            .Paragraphs.Add
        End With
    End Sub
    

    Now adding your score details is simply

    '--- add totals and overall score at the end of the document
    AppendScoreDetail "Incorrect: " & yellowErrors, wdYellow, testDoc
    AppendScoreDetail "Omitted: " & blueErrors, wdTurquoise, testDoc
    AppendScoreDetail "Added: " & greenErrors, wdBrightGreen, testDoc
    AppendScoreDetail "Total: " & totalErrors, wdNoHighlight, testDoc
    AppendScoreDetail "Score: " & Format$(score, "00.00%"), wdNoHighlight, testDoc
    AppendScoreDetail "Grader's Name: ", wdNoHighlight, testDoc
    
  3. I left the logic for copying your score to the clipboard largely intact since there is no real way to improve that. However, as I'm reading the code I don't understand why you're copying it to the clipboard or if a specific format is required. The comments you have in your code are redundant because the code itself is documenting what you're doing (especially if you continue to use descriptive variable names). The comments I appreciate are the ones that tell me why something is being done. You might always be the only person ever to look at your code, but I guarantee you'll forget why you did things a certain way three years from now.

  4. Don't forget to re-enable Application.ScreenUpdating = True at the end of your logic.

For convenience, here is the entire module in a single block:

Option Explicit
'@Folder("Grading Macro")

Public Sub GradingMacro()
    Application.ScreenUpdating = False

    Dim testDoc As Document
    Dim yellowErrors As Long
    Dim blueErrors As Long
    Dim greenErrors As Long
    Dim totalErrors As Long
    Set testDoc = ActiveDocument
    yellowErrors = CountFormattedWords(wdYellow, testDoc)
    blueErrors = CountFormattedWords(wdTurquoise, testDoc)
    greenErrors = CountFormattedWords(wdBrightGreen, testDoc)
    totalErrors = yellowErrors + blueErrors + greenErrors

    '--- total word count should be the only text in the document
    '    using Italic format
    Dim wordTotal As Long
    Dim wordCount As Range
    Set wordCount = testDoc.Content
    With wordCount.Find
        .Font.Italic = True
        .Wrap = wdFindStop
        .Execute
        If .Found Then
            wordTotal = CLng(wordCount)
        Else
            '--- do something if we didn't find it
            MsgBox "ERROR! Can't find the Total Words count!"
            Exit Sub
        End If
    End With

    Dim score As Double
    score = (wordTotal - totalErrors) / wordTotal

    '--- add totals and overall score at the end of the document
    AppendScoreDetail "Incorrect: " & yellowErrors, wdYellow, testDoc
    AppendScoreDetail "Omitted: " & blueErrors, wdTurquoise, testDoc
    AppendScoreDetail "Added: " & greenErrors, wdBrightGreen, testDoc
    AppendScoreDetail "Total: " & totalErrors, wdNoHighlight, testDoc
    AppendScoreDetail "Score: " & Format$(score, "00.00%"), wdNoHighlight, testDoc
    AppendScoreDetail "Grader's Name: ", wdNoHighlight, testDoc

    '--- but WHY are you copying the score to the clipboard (the code
    '    says what you're doing)
    Dim clipboard As DataObject
    Dim textToClip As String
    Dim formattedScore As Variant
    Dim pasteScore As Variant
    formattedScore = Format$(score, "Percent")
    pasteScore = Format$(score * 100, "Standard")
    Set clipboard = New DataObject
    textToClip = pasteScore
    clipboard.SetText textToClip
    clipboard.PutInClipboard

    Application.ScreenUpdating = True
End Sub

Private Function CountFormattedWords(ByVal checkIndex As WdColorIndex, _
                                     Optional ByRef checkDoc As Document = Nothing) As Long
    '--- counts the number of words in the document highlighted with
    '    the given highlight color index
    Dim thisDoc As Document
    If checkDoc Is Nothing Then
        Set thisDoc = ThisDocument
    Else
        Set thisDoc = checkDoc
    End If

    Dim checkWord As Variant
    For Each checkWord In thisDoc.Words
        If checkWord.HighlightColorIndex = checkIndex Then
            CountFormattedWords = CountFormattedWords + 1
        End If
    Next checkWord
End Function

Private Sub AppendScoreDetail(ByVal thisText As String, _
                              ByVal thisHighlight As WdColorIndex, _
                              Optional ByRef checkDoc As Document = Nothing)
    Dim thisDoc As Document
    If checkDoc Is Nothing Then
        Set thisDoc = ThisDocument
    Else
        Set thisDoc = checkDoc
    End If

    Dim newText As Paragraph
    Set newText = thisDoc.Content.Paragraphs.Add
    With newText.Range
        .Text = thisText
        .Font.Italic = False
        .Font.Underline = False
        .Font.Bold = True
        .Font.Name = "Arial Black"
        .Font.Size = 11
        .HighlightColorIndex = thisHighlight
        .Paragraphs.Add
    End With
End Sub
\$\endgroup\$
  • \$\begingroup\$ This is amazing! I have a few follow-up questions. What is the best way to print the score details? If I'm reading this correctly this does everything up to that but doesn't print the itemized score. Second, I realized currently the percentage rounds up to the hundreth, which we cannot. I searched for a way to display the non-rounded percentage and all I've found that seems to work is something like this: 'score = ((wordTotal - totalErrors) / wordTotal) * 100 scoreNoRound = (Int(score * 100)) / 100 ' Can I add this into the existing code declaring scoreNoRound as Variable? \$\endgroup\$ – Abernaughty Mar 14 at 2:19
  • \$\begingroup\$ The code above does print the score, at least in the same format as shown in your graded transcript image. That's what the AppendScoreDetail routine is doing (I created a test document identical to your image, and the code worked to append the score details). To change the format of the score display, don't worry about rounding. It's all in how it's formatted. Change the format string in the above code from "00.00%" to what you need, e.g. "00.0%" or "00%". You don't need an extra variable or anything. \$\endgroup\$ – PeterT Mar 14 at 2:48
  • \$\begingroup\$ Hmm, you're right but somehow it's not printing it into the document I'm using it in, but when I open a new blank document it is printed there. I inserted the module under the Normal Project, is that the correct place to add it? Concerning the formatting if I need it to show 2 digits before and 2 digits after the decimal, using 00.00% seems to still be rounding the thousands place. I feel like I'm being dense here but I'm too dense to know how haha. \$\endgroup\$ – Abernaughty Mar 14 at 4:13
  • \$\begingroup\$ This is my mistake, code is corrected in the answer above. For the call to AppendScoreDetail I should have included the testDoc parameter. So the call should be similar to AppendScoreDetail "Incorrect: " & yellowErrors, wdYellow, testDoc. Add that to each call and it should work. \$\endgroup\$ – PeterT Mar 14 at 15:26
  • 1
    \$\begingroup\$ Great answer as always! One thing though, in Word the Selection is a full-fledged object with an early-bound public interface, ...very different than in Excel where it could be anything... if the selection is a Chart and you set it to a Worksheet object, boom. Declaring it as a variant will only defer the bug further down, where a late-bound member call is made for e.g. a Range property that a Chart object doesn't have. Word's selection invokes are early-bound and blow up at compile time if invalid, before any code gets to run. Word wins the Selection battle, in spades ;-) \$\endgroup\$ – Mathieu Guindon Mar 15 at 1:25
7
\$\begingroup\$

There are 5 steps you could take after which you could repost your code here.

  1. Use 'Option Explicit' in each module and address the errors that this will show.

  2. If you are able, install the RubberDuck addin. Use the 'RubberDuck' addin to do a code inspection and then address all the issues you find.

  3. Split your code into simple functions/subs. At the moment your macro does a number of tasks. You should aim to separate your code into a set of small and simple subs and functions.

  4. Use RubberDuck to write some unit tests for your newly created subs and functions. This will be extremely useful for the person who inherits your code.

  5. Use meaningful names. At the moment you have a tendency towards a naming convention called systems Hungarian (e.g. objWord). This style of naming is deprecated as such names are not useful because they say nothing about the purpose of the variable or function/sub. Try using names that mean something in the context of the task in hand. e.g. test_doc.

\$\endgroup\$
  • \$\begingroup\$ Welcome to Code Review! +1 for RD, but provide the link to. You should add advice to keep DRY (Don't Repeat Yourself) and Identifiers should be CamelCase (Improves readbility and typos are recognized at once if you type them lowercase outside declaration and they stay lowercase). \$\endgroup\$ – ComputerVersteher Mar 9 at 15:08
  • \$\begingroup\$ Thank you so much! I'd never heard of RubberDuckVBA, what a great tool. I did my best to follow your advice. I'm now using 'Option Explicit' and declared the variables I'd missed, did a code inspection and resolved all the errors/warnings, and did my best to use more descriptive variable names. There were a few places where I was unsure how to best replace the Hungarian Notation with more meaningful variable names such as with oRng, as I don't know that I completely understand it's usage. I've edited the post with the revised code if you have any additional suggestions. \$\endgroup\$ – Abernaughty Mar 10 at 4:23
  • \$\begingroup\$ Regarding your advice to split my code into multiple functions/subs, are you saying it would be better to have a sub for each of the individual functions of the macro that I have commented, and then call each of those within another function? I've seen that advice from others now that I look around, but to clarify what is the benefit of doing that? Just to make the macro more modular and easier to troubleshoot? \$\endgroup\$ – Abernaughty Mar 10 at 6:26
  • 1
    \$\begingroup\$ It makes it much easier to check that your code works as it should. The smaller functions can be given meaningful names so that you code becomes self documenting. \$\endgroup\$ – Freeflow Mar 10 at 9:28
5
\$\begingroup\$

Well that's great progress. I now have some more comments.

  1. Brute force rather than precision

Your search for highlighted words is using a 'brute force' approach as you are examining every word rather than using the Word search function to search for words with a specific highlight.

2 Multiple variables rather than grouped data

Your are using multiple variables for a set of grouped data. You can simplify your code by declaring a Type (simple) or object (slightly more complicated). e.g you could declare a type called 'Scorecard' which has fields of Incorrect, Omitted, Added, Total and Percent. In fact if I were doing this problem Scorecard would be an object with the searching and summing routines encapsulated in the class.

  1. Find total word count comment.

This is an example of useless commenting. Sorry to be so rude. But the comment requires us to know that you have encoded the total words already in the document and that it is the only italicised word on the page. A much better comment would be to say exactly that. ' The total word count is located at the foot of the document and is the only italicised word in the document'. BUT this is also possibly a waste of time because you document structure is not taking advantage of templates.

  1. Coding rather than template.

You insert the report of the score by creating the text programatically. This is where words Template system comes to our aid. A better starting position might be that you have a Template with a Table that contains the report details. One column for the labels and one column for the scores. Even if you didn't want or can't use a template I'd still prefer to insert a table as this would make the subsequent programming much easier to follow.

  1. Screen updating.

You turn it off but never turn it back on again.

  1. Unnecessary calculations

When you are calculating the totals for each highlight you also update the overall total. This isn't necessary, you can add the totals for the green, blue and yellow highlights at the end of the loop.

\$\endgroup\$
  • \$\begingroup\$ Appreciate the feedback. I'm only about 2 1/2 weekends deep in VBA at this point so this kind of direction is exactly what I'm looking for. You're right about the 'brute force' approach. Would the Find.Execute method be more suitable? Scorecard I've not encountered yet, I'll look into that. My commenting at this point is mostly so that I can organize and navigate the code more easily, but admittedly it does little to help the reader. I'll look into using a template and table, as well as fixing the screen updating and calculations. I've got a lot to read up on here, thanks very much! \$\endgroup\$ – Abernaughty Mar 10 at 13:21
  • \$\begingroup\$ Use the macro recorder to see how VBA would achieve a task but be aware that the macro recorder produces rather bad code. You can get help on any keyword by placing the cursor on the keyword and pressing F1. For word objects putting the cursor on the keyword and pressing Shift F2 will take you to the object browser with the object displayed. \$\endgroup\$ – Freeflow Mar 10 at 16:20
1
\$\begingroup\$

Having provided so much comment I thought it was only fair to post what my version of your code would be. There is a deliberate error in the code. I wonder what your thoughts are on how easy it is to spot? I also can't guarantee that the code will work as intended(although it does compile) as a don't have a sample document to test it on.

Option Explicit

Public Enum ErrorType
    ' Colors are selected from the Word.WdColourIndex enumeration
    Omitted = wdTurquoise
    Incorrect = wdYellow
    Added = wdBrightGreen

End Enum

Public Type ScoreCard

    Omittted                                As Long
    Incorrect                               As Long
    Added                                   As Long
    TotalErrors                             As Long
    TotalWords                              As Long
    Score                                   As Double ' Total errors as a percent of total words

End Type

Public Enum ReportRow
    [_First] = 1                ' The [_ and] means that the enumeration item will not appear in the intellisense
    Incorrect = 1
    Omittted = 2
    Added = 3
    TotalErrors = 4
    Score = 5
    GraderName = 6
    [_Last] = GraderName

End Enum

Public Const TABLE_COLUMNS                 As Long = 2

Sub CountErrorsByErrorType()

Dim my_scorecard                            As ScoreCard
Dim my_score_for_pasting                    As DataObject

    With my_scorecard

        .TotalWords = GetTotalWordsCount
        .Added = CountWordsWithError(ErrorType.Omitted, True, True)
        .Incorrect = CountWordsWithError(ErrorType.Incorrect, this_document:=ActiveDocument)
        .Omittted = CountWordsWithError(ErrorType.Omitted)
        .TotalErrors = .Added + .Omittted + .Incorrect

    End With

    CreateReport my_scorecard

    Set my_score_for_pasting = New DataObject
    my_score_for_pasting.SetText = Format$(my_scorecard.Score, "0.00% ")
    my_score_for_pasting.PutInClipboard

    MsgBox _
        "Scoring completed" _
        & vbCrLf & vbCrLf _
        & "Score was " _
        & CStr(my_scorecard.Score) _
        & vbCrLf & vbCrLf _
        & "Remeber to paste the score!!", _
        vbOKOnly
End Sub

Public Function CountWordsWithError _
( _
    ByVal this_score_highlight_color As ErrorType, _
    Optional ByVal this_bold As Boolean = False, _
    Optional ByVal this_underline As Boolean = False, _
    Optional ByRef this_document As Word.Document _
) As Long

Dim my_count                                As Long
Dim my_document                             As Word.Document

    Set my_document = IIf(this_document Is Nothing, ActiveDocument, this_document)

    With my_document.StoryRanges(wdMainTextStory)

        With .Find

            .ClearFormatting
            .Text = ""
            .Format = True
            .Highlight = True
            .Font.Bold = this_bold
            .Font.Underline = this_underline
            .Wrap = wdFindStop
            ' Put any other search options here
            .Execute Wrap:=wdFindStop

        End With

        Do While .Find.Found

           If .HighlightColorIndex = this_score_highlight_color Then

                my_count = my_count + 1

            End If

           .Collapse Direction:=wdCollapseEnd
           .Move unit:=wdCharacter, Count:=1
           .Find.Execute

        Loop

    End With

    CountWordsWithError = my_count

End Function

Public Function GetTotalWordsCount(Optional ByRef this_document As Word.Document) As Long

Dim my_document                             As Word.Document

    Set my_document = IIf(this_document Is Nothing, ActiveDocument, this_document)

    With my_document.StoryRanges(wdMainTextStory)

        With .Find

            .ClearFormatting
            .Text = ""
            .Wrap = wdFindStop
            .Font.Italic = True
            .Execute

            If .Found Then

                GetTotalWordsCount = CStr(.Text)

            Else

                MsgBox "The total word count was not found", vbOKOnly
                End

            End If

        End With

    End With

End Function

Public Sub CreateReport(ByRef this_scorecard As ScoreCard, Optional ByRef this_document As Word.Document)

Dim my_document                     As Word.Document
Dim my_range                        As Word.Range

    Set my_document = IIf(this_document Is Nothing, ActiveDocument, this_document)

    With this_scorecard

        .Score = ((.TotalWords - .TotalErrors) / .TotalWords) * 100

    End With

    If my_document.Tables.Count = 0 Then

        my_range = my_document.StoryRanges(wdMainTextStory)
        my_range.Collapse Direction:=wdCollapseEnd
        InsertReportTable my_range, ReportRow.[_Last], 2

    End If

    With my_document.Tables(1).Range.COLUMNS(2)

        .Cells(ReportRow.Incorrect).Range.Text = CStr(this_scorecard.Incorrect)
        .Cells(ReportRow.Omittted).Range.Text = CStr(this_scorecard.Omittted)
        .Cells(ReportRow.Added).Range.Text = CStr(this_scorecard.Added)
        .Cells(ReportRow.TotalErrors).Range.Text = CStr(this_scorecard.TotalErrors)
        .Cells(ReportRow.Score).Range.Text = CStr(this_scorecard.Score)

    End With

End Sub

Sub InsertReportTable(ByRef this_range, Optional ByVal this_rows As Long = -1, Optional ByVal this_columns As Long = -1)

Dim my_rows                     As Long
Dim my_columns                  As Long

    my_rows = IIf(this_rows = -1, ReportRow.[_Last], this_rows)
    my_columns = IIf(this_columns = -1, TABLE_COLUMNS, this_columns)
    this_range.Tables.Add this_range, my_rows, my_columns

    With this_range.Tables(1).Range.COLUMNS(1)

        .Cells(ReportRow.Incorrect).Range.Text = "Incorrect:"
        .Cells(ReportRow.Omittted).Range.Text = "Omitted:"
        .Cells(ReportRow.Added).Range.Text = "Added:"
        .Cells(ReportRow.TotalErrors).Range.Text = "Total Errors:"
        .Cells(ReportRow.Score).Range.Text = "Score:"
        .Cells(ReportRow.GraderName).Range.Text = "Grader's name"

    End With

    this_range.Tables(1).Range.Paragraphs.Alignment = wdAlignParagraphLeft

End Sub
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.