0

I am using Shree lipi NXT software to type Gujarati & Hindi, but my problem is MS Office doesn't recognise that non unicode words' spelling are correct or not, in short in my case MS Office spell check is not working. So I want a macro which can mark all non unicode words as a misspelled words. so I can check and if need correct and add them to my own dictionary.

As we can see in first line I typed in unicode font named Shruti and there is one word marked as a error, but in second line I typed with Shree Lipi but there those word are not marked. Even if I type any misspelled words with Shree Lipi MS office's spell check doesn't work.

I have no proper knowledge of both language so I must need spell checker, without spell checker my work will be very time consuming.

I try some macros but those have code errors. one of them as bellow.

Dim dictRange As Range
Dim dictWords As Object
Dim wordColors As Object

Private Sub Document_ContentControlOnEnter(ByVal ContentControl As ContentControl)
    Set dictRange = ActiveDocument.Content
    Set dictWords = GetDictionaryWords()
    Set wordColors = CreateObject("Scripting.Dictionary")
End Sub

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl)
    ChangeWordColor
End Sub

Function IsWordInDictionary(ByVal word As String) As Boolean
    If Not dictWords Is Nothing Then
        IsWordInDictionary = dictWords.Exists(word)
    Else
        IsWordInDictionary = False
    End If
End Function

Sub ChangeWordColor()
    Dim wordRange As Range
    Dim word As Range
    Dim wordText As String
    Dim wordColor As Long
 
    ' Loop through each word in the document
    For Each wordRange In ActiveDocument.Words
        Set word = wordRange.Duplicate
        word.Collapse wdCollapseStart
        wordText = Trim(word.Text)       
        ' Check if the word is in the dictionary
    If Len(wordText) > 0 Then
        If Not IsWordInDictionary(wordText) Then
            ' Word not found in the dictionary, change the color to red
            wordColor = wordRange.Font.Color
            If Not wordColors.Exists(wordText) Then
                wordColors.Add wordText, wordColor
                End If
                wordRange.Font.Color = wdColorRed
            Else
                ' Word found in the dictionary, restore the original color
                If wordColors.Exists(wordText) Then
                    wordColor = wordColors(wordText)
                    wordRange.Font.Color = wordColor
                End If
            End If
        End If
    Next wordRange
End Sub

Function GetDictionaryWords() As Object
    Dim dictFile As String
    dictFile = "D:\Files Contineus backup to GoogleDrive\CustomOfficeDictionaryOneDrive\CorrectWordsOneDriveGuj.dic"

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim dictWords As Object
    Set dictWords = Nothing

    If fso.FileExists(dictFile) Then
        Dim fileStream As Object
        Set fileStream = fso.OpenTextFile(dictFile, 1)
    
        Set dictWords = CreateObject("Scripting.Dictionary")
    
        Do Until fileStream.AtEndOfStream
            Dim dictWord As String
            dictWord = Trim(fileStream.ReadLine)
         
            If Not dictWords.Exists(dictWord) Then
                dictWords.Add dictWord, ""
            End If
        Loop
    
        fileStream.Close
    End If

    Set GetDictionaryWords = dictWords
End Function
Robert
  • 7,394
  • 40
  • 45
  • 64

0 Answers0