Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 08-22-2019, 03:30 PM
jeffreybrown jeffreybrown is offline List Spelling Errors Windows 10 List Spelling Errors Office 2016
Expert
List Spelling Errors
 
Join Date: Apr 2016
Posts: 673
jeffreybrown has a spectacular aura aboutjeffreybrown has a spectacular aura about
Default 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
Reply With Quote
  #2  
Old 08-22-2019, 05:10 PM
gmaxey gmaxey is offline List Spelling Errors Windows 10 List Spelling Errors Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,422
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

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
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #3  
Old 08-22-2019, 05:48 PM
jeffreybrown jeffreybrown is offline List Spelling Errors Windows 10 List Spelling Errors Office 2016
Expert
List Spelling Errors
 
Join Date: Apr 2016
Posts: 673
jeffreybrown has a spectacular aura aboutjeffreybrown has a spectacular aura about
Default

Hi Greg,

That does indeed meet my needs and for it I am very grateful.
Reply With Quote
  #4  
Old 02-22-2020, 12:12 AM
dita dita is offline List Spelling Errors Windows XP List Spelling Errors Office 2010 64bit
Advanced Beginner
 
Join Date: Apr 2018
Posts: 34
dita is on a distinguished road
Default

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?
Reply With Quote
  #5  
Old 03-23-2020, 03:43 PM
dita dita is offline List Spelling Errors Windows XP List Spelling Errors Office 2010 64bit
Advanced Beginner
 
Join Date: Apr 2018
Posts: 34
dita is on a distinguished road
Default

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!
Reply With Quote
Reply

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
List Spelling Errors Stuck in US spelling Peborgh Word 7 06-23-2015 04:46 PM
List Spelling Errors 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

Other Forums: Access Forums

All times are GMT -7. The time now is 12:17 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft