Excel 2010 spellcheck text in shapes within a range

Hello Experts,

I would like Excel to spell check text held in shapes within a given range as in the attached sample sheet.

Appreciate your suggestions.

biker9
Spelchecker.xlsm
biker9Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

pjwallisCommented:
Hi,

Can you have a look at the following document.

http://danielcurran.com/instructions/how-to-use-spell-check-in-an-excel-spreadsheet-or-workbook/

To auto select press Ctrl G and type in the range a1:M50 and click ok.
It will keep the different ranges so you don't have to type them in again.

Then F7 to spell check that selected range.

See http://office.microsoft.com/en-au/excel-help/select-specific-cells-or-ranges-HP001217037.aspx


This is a macro to do the same thing. I just recorded the actions listed above and it works fine if I mispell a word in the range and press Ctrl l.

Sub myspelling()
'
' myspelling Macro
'
' Keyboard Shortcut: Ctrl+l
'
    Application.Goto Reference:="R1C1:R50C13"
    Selection.CheckSpelling SpellLang:=3081
End Sub

See the following article about references to cells etc.

http://office.microsoft.com/en-au/excel-help/about-cell-and-range-references-HP005198323.aspx

I have assigned the macro to the blue box and it should work okay for you.

Hope that helps.

pjwallis
Fixed-with-Macro.xlsm
0
biker9Author Commented:
Hello pjwallis,
thanks for taking a look at this, I don't think that approach will isolate only text in shapes within a defined range. It works fine for text within cells tho.

pls see the attached,
tx,
biker9
Not-Fixed-with-Macro.xlsm
0
pjwallisCommented:
Sorry I miss understood what you needed. I'm mobile till thursday, will have another look when i get back home.
pjwallis
0
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

Martin LissOlder than dirtCommented:
Here's code that you can use. It uses Word's spellchecker so of course Word is assumed to be present but not necessarily running on the PC. If you are no longer using groups of shapes then you can remove lines 33 to 38 and 43.

Option Explicit
Private bErrorsFound As Boolean
Public Sub spellcheck()


Dim rngSpelCheck As Range


Set rngSpelCheck = ActiveSheet.Range("A1:L50")

ExtractTextAndSpellcheck rngSpelCheck
If Not bErrorsFound Then
    MsgBox "No spelling errors found"
End If
End Sub
Sub ExtractTextAndSpellcheck(ByRef objRange As Range)

Dim c As Integer
Dim rng As Range
Dim shp As Shape
Dim shpInGroup As Shape
Dim lngIndex As Long
Dim strWords() As String
Dim strText As String
    
    Range("w10").Select

    Set rng = ActiveCell
    
    On Error Resume Next
    For Each shp In ActiveSheet.Shapes
        If Not (Intersect(shp.TopLeftCell, objRange) Is Nothing) Or Not Intersect(shp.BottomRightCell, objRange) Is Nothing Then
            If shp.Type = msoGroup Then ' shp.Ungroup
                For lngIndex = 1 To shp.GroupItems.Count
                    Set shpInGroup = shp.GroupItems(lngIndex)
                    shpInGroup.TextFrame.Characters.Text = SpellWord(shpInGroup.TextFrame.Characters.Text)
                Next
            Else
                If shp.TextFrame.Characters.Text <> "" Then
                    shp.TextFrame.Characters.Text = SpellWord(shp.TextFrame.Characters.Text)
                End If
            End If
        End If
    Next shp
 
End Sub
Private Function SpellWord(strWord As String) As String
    ' Word must be installed for this to work
    ' objDoc.Checkgrammar ' use this to check grammar
    
    Dim objWord As Object
    Dim objDoc  As Object
    Dim strResult As String
    Dim bWordAlreadyOpen As Boolean

    Const QUOTE = """"
    
    If IsAppRunning("Word.Application") = True Then
        Set objWord = GetObject(, "Word.Application")
        bWordAlreadyOpen = True
    Else
        Set objWord = CreateObject("Word.Application")
    End If

    Select Case objWord.Version
        'Office 2000 and later
        Case "9.0", "10.0", "11.0", "14.0"
            Set objDoc = objWord.Documents.Add(, , 1, True)
        'Office 97
        Case "8.0"
            Set objDoc = objWord.Documents.Add
        Case "Else"
            MsgBox "Sorry but your version of Word seems to be " & QUOTE & objWord.Version _
                   & QUOTE & " and that version is not currently supported.", vbOKOnly + vbExclamation, "Spelling Checker"
            Exit Function
    End Select

    objDoc.Content = strWord
    objDoc.CheckSpelling
    objWord.Visible = False

    strResult = Left(objDoc.Content, Len(objDoc.Content) - 1)
    ' Reformat carriage returns
    strResult = Replace(strResult, Chr(10), Chr(13) & Chr(10))
    
    If strWord <> strResult Then
        bErrorsFound = True
    End If
    
    'Clean up
    objDoc.Close False
    Set objDoc = Nothing
    If Not bWordAlreadyOpen Then
        objWord.Application.Quit True
        Set objWord = Nothing
    End If

    ' Replace the text with the corrected text. It's important that
    ' this be done after the "Clean Up" because otherwise there are problems
    ' with the screen not repainting
    SpellWord = strResult

    Exit Function


ErrorRoutine:

    Select Case Err.Number
        Case 429
            MsgBox "Word must be installed in order for this code to work", vbCritical + vbOKOnly, "Spelling Checker"
    End Select
End Function
Function IsAppRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
    Set oApp = Nothing
    IsAppRunning = True
End If
End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Martin LissOlder than dirtCommented:
… deleted… replied to wrong thread.
0
biker9Author Commented:
Thank you once again Martin!
biker9

ps; do you offer consulting services?
0
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help. I'm sorry but I don't do consulting but I'm happy to answer any of your questions that I can.  

Marty - MVP 2009 to 2013
0
biker9Author Commented:
Thanks Martin,

I've posted a new question re: consulting, titled "Advice on how to move an Excel, VBA project forward?”

biker9
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.