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.
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