#1
|
|||
|
|||
List Spelling Errors
I used this macro today written by Greg Maxey and it works fantastic. If possible though, can it be tweaked to show the page number where the first occurrence is found? List Spelling Errors |
#2
|
|||
|
|||
Jeffery,
Some of us try to make a living doing this sort of stuff. Donations help. That is some old stuff. I'm not going to try to refine it, but this should meet your need. In the class module: Code:
Option Explicit Private mName As String Private mCount As Long Private mPage As String Public Property Get Name() As String 'The Property Get procedure passes a class property value to a calling Sub or 'Function. Name = mName End Property Public Property Let Name(NewValue As String) 'The Property Let procedure allows the passing Sub or Function to assign a value to the 'Class property mName. It must have same name i.e., Let Name as its corresponding 'Property Get Name procedure above. mName = NewValue End Property Public Property Get PagNum() As String 'The Property Get procedure passes a class property value to a calling Sub or 'Function. PagNum = mPage End Property Public Property Let PagNum(NewValue As String) 'The Property Let procedure allows the passing Sub or Function to assign a value to the 'Class property mName. It must have same name i.e., Let Name as its corresponding 'Property Get Name procedure above. mPage = NewValue End Property Public Property Get Count() As Long Count = mCount End Property Public Property Let Count(NewValue As Long) mCount = NewValue End Property In the standard module: Code:
Option Explicit Sub SpellingErrorReport() Dim oError As clsError 'clsError is the class module name 'each unique spelling error will be an 'instance in the class module Dim colErrors As Collection 'Collection of unique spelling errors Dim oSpErrors As ProofreadingErrors Dim oSpError As Word.Range Dim oSpErrorCnt As Integer 'Number of total misspelled words Dim uniqueSPErrors As Integer 'Number of unique misspelled words Dim bolSortByFreq As Boolean 'Flag for sorting order Dim j As Integer 'Temp values for sorting Dim k As Integer Dim l As Integer Dim tempCount As Integer Dim tempString As String Dim oRng As Word.Range Dim oTbl As Table Set colErrors = New Collection Set oSpErrors = ActiveDocument.Range.SpellingErrors 'Set sort order bolSortByFreq = True If MsgBox("The default sort order is error freqeuncy." _ & vbCr & "Do you want to sort errors" _ & " alphabetically instead?", vbYesNo) = vbYes Then bolSortByFreq = False End If For Each oSpError In oSpErrors On Error Resume Next 'Sets oError to the value of colErrors(Misspelled Word) 'if it already exist in collection Set oError = colErrors(oSpError.Text) 'If it doesn't exist in colErrors then oError remains set to Nothing On Error GoTo 0 'Not in the collection then create new Class instance and add error to colErrors If oError Is Nothing Then 'Create new Class instance Set oError = New clsError 'Call Property Let Procedure in Class module and pass value to .Name property oError.Name = oSpError.Text If oError.PagNum = vbNullString Then oError.PagNum = oSpError.Information(wdActiveEndPageNumber) End If 'Add to colError. Calls Propert Get Procedure in Class module to retrieve .Name value colErrors.Add oError, oError.Name End If 'Increment count oError.Count = oError.Count + 1 Set oError = Nothing Next 'Sort for Display For j = 1 To colErrors.Count - 1 k = j For l = j + 1 To colErrors.Count If (Not bolSortByFreq And colErrors(l).Name < colErrors(k).Name) _ Or (bolSortByFreq And colErrors(l).Count > colErrors(k).Count) Then k = l Next l If k <> j Then tempString = colErrors(j).Name colErrors(j).Name = colErrors(k).Name colErrors(k).Name = tempString tempCount = colErrors(j).Count colErrors(j).Count = colErrors(k).Count colErrors(k).Count = tempCount End If Next j 'Display Results oSpErrorCnt = ActiveDocument.Range.SpellingErrors.Count uniqueSPErrors = colErrors.Count Set oRng = ActiveDocument.Range oRng.Move oRng.InsertBreak wdSectionBreakNextPage oRng.Select Selection.ParagraphFormat.TabStops.ClearAll With Selection For Each oError In colErrors .TypeText Text:=oError.Name & vbTab & oError.PagNum & vbTab & oError.Count & vbCrLf Next End With Selection.Sections(1).Range.Select Selection.ConvertToTable Selection.Collapse wdCollapseStart Set oTbl = Selection.Tables(1) oTbl.Rows.Add BeforeRow:=Selection.Rows(1) oTbl.Cell(1, 1).Range.InsertBefore "Spelling Error" oTbl.Cell(1, 2).Range.InsertBefore "PFO" oTbl.Cell(1, 3).Range.InsertBefore "# Occurrences" oTbl.Columns(3).Select Selection.ParagraphFormat.Alignment = wdAlignParagraphRight Selection.Collapse wdCollapseStart oTbl.Rows(1).Shading.BackgroundPatternColor = wdColorGray20 oTbl.Columns(1).PreferredWidth = InchesToPoints(4.5) oTbl.Columns(2).PreferredWidth = InchesToPoints(1) oTbl.Columns(3).PreferredWidth = InchesToPoints(1) oTbl.Rows.Add oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Summary" oTbl.Cell(oTbl.Rows.Count, 3).Range.InsertBefore "Total" oTbl.Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorGray20 oTbl.Rows.Add oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Number of Unique Misspellings" oTbl.Cell(oTbl.Rows.Count, 3).Range.InsertBefore Trim(Str(uniqueSPErrors)) oTbl.Rows(oTbl.Rows.Count).Shading.BackgroundPatternColor = wdColorAutomatic oTbl.Rows.Add oTbl.Cell(oTbl.Rows.Count, 1).Range.InsertBefore "Total Number of Spelling Errors" oTbl.Cell(oTbl.Rows.Count, 3).Range.InsertBefore Trim(Str(oSpErrorCnt)) Selection.HomeKey wdStory End Sub |
#3
|
|||
|
|||
Hi Greg,
That does indeed meet my needs and for it I am very grateful. |
#4
|
|||
|
|||
I have tried to use this macro in Word 2013 but got the following error message:
Compile error: User-defined type not defined It stops at: Sub SpellingErrorReport() Dim oError As clsError I have pasted the code in the class module and the standard module but does not work. Does anyone know if I should paste it in a specific module/class number? |
#5
|
|||
|
|||
Hi,
I was able to run the macro in the end I just needed to rename the class module as clsError. Can the macro be tweaked a little bit more so that the table with spelling errors is created in a new document?
Thank you! |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Family tree hierarchy in PowerPoint: bugs/errors red X's in bulletpoint list | delta9@gmail.com | PowerPoint | 1 | 11-28-2015 10:44 AM |
Stuck in US spelling | Peborgh | Word | 7 | 06-23-2015 04:46 PM |
How to fix "too many spelling errors" bug? | Lebber | Word | 9 | 04-26-2013 12:59 AM |
spelling checker | charlotte84 | Word | 2 | 03-29-2012 05:09 AM |
How to take the tick out of Spelling in GPO? | Swarv | Word | 0 | 09-29-2010 02:16 AM |