Spell Check an RTF Memo field

[paulfain]

I am experimenting with Rich Text Formatting in memo fields, using S. Lebans ocx addins. Works great but I now find that I cannot do a simple spell check on these memo fields when displayed in a form. I'm not sure why. Spell check begins to execute but Access looses focus on the current form and starts jumping around into different records in the table, and fails to display any spell check information. You would think that the spell checker would check the table data and simply report the unrecognized characters as being mispelled, but it doesn't. Any Ideas on how to do a simple spell check on these memo fields ?
Thanks in advance for any suggestions.

 

[compucop]

I use this code to call Microsoft word spell checker.. This is the only way I know how to spell check a rich text box. Later. Good Luck

Dim OWORD As Object
Dim OTMPDOC As Object
Dim LORIGTOP As Long

Set OWORD = CreateObject("WORD.APPLICATION&quot
Set OTMPDOC = OWORD.Documents.Add
OWORD.Visible = False

LORIGTOP = OWORD.Top
OWORD.WINDOWSTATE = 0
OWORD.Top = -30000
Me.RichTextBox.SelStart = 0 ' SUBSTITUTE YOUR RTF BOX
Me.RichTextBox.SelLength = Len(Me.RichTextBox.Text)
SetText Me.RichTextBox.SelText


With OTMPDOC
.content.Paste
.Activate
.CHECKSPELLING
.checkgrammar
.content.Copy

Me.RichTextBox.Text = GetText
.saved = True
.Close
End With

Set OTMPDOC = Nothing
OWORD.Top = LORIGTOP
OWORD.Visible = False

OWORD.Quit
Set OWORD = Nothing

 

[paulfain]

Thank you for this suggestion. But when I try to compile it, the line...

SetText Me.MyTextBox.SelText

seems to be calling a procedure (SetText) which is not in my project. Any further help on this please?

 

[compucop]

I see what you mean, that is the function I used to copy and paste the information into the spell checker. Below are the two function I used to copy and paste text into the spell checker. copy these into your module section of your project. Let me know how you make out. Later.

Option Compare Database
Option Explicit

' From Access 2000 Developer's Handbook, Volume I
' by Getz, Litwin, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.

' Clipboard class

Private Declare Function IsClipboardFormatAvailable _
Lib "user32" _
(ByVal uFormat As Integer) As Integer
Private Declare Function OpenClipboard _
Lib "user32" _
(ByVal hWnd As Long) As Integer
Private Declare Function GetClipboardData _
Lib "user32" _
(ByVal uFormat As Integer) As Long
Private Declare Function GlobalSize _
Lib "kernel32" _
(ByVal hMem As Long) As Integer
Private Declare Function GlobalLock _
Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Sub MoveMemory _
Lib "kernel32" Alias "RtlMoveMemory" _
(ByVal strDest As Any, _
ByVal lpSource As Any, _
ByVal Length As Long)
Private Declare Function GlobalUnlock _
Lib "kernel32" _
(ByVal hMem As Long) As Integer
Private Declare Function CloseClipboard _
Lib "user32" () As Integer
Private Declare Function GlobalAlloc _
Lib "kernel32" _
(ByVal uFlags As Integer, ByVal dwBytes As Long) As Long
Private Declare Function EmptyClipboard _
Lib "user32" () As Integer
Private Declare Function SetClipboardData _
Lib "user32" _
(ByVal uFormat As Integer, ByVal hData As Long) As Long
Private Declare Function GlobalFree _
Lib "kernel32" _
(ByVal hMem As Long) As Long

Private Const GMEM_MOVABLE = &H2&
Private Const GMEM_DDESHARE = &H2000&
Private Const CF_TEXT = 1

'Error return codes from Clipboard2Text
Private Const CLIPBOARDFORMATNOTAVAILABLE = 1
Private Const CANNOTOPENCLIPBOARD = 2
Private Const CANNOTGETCLIPBOARDDATA = 3
Private Const CANNOTGLOBALLOCK = 4
Private Const CANNOTCLOSECLIPBOARD = 5
Private Const CANNOTGLOBALALLOC = 6
Private Const CANNOTEMPTYCLIPBOARD = 7
Private Const CANNOTSETCLIPBOARDDATA = 8
Private Const CANNOTGLOBALFREE = 9

Function SetText(strText As String) As Variant
Dim varRet As Variant
Dim fSetClipboardData As Boolean
Dim hMemory As Long
Dim lpMemory As Long
Dim lngSize As Long

varRet = False
fSetClipboardData = False

' Get the length, including one extra for a CHR$(0)
' at the end.
lngSize = Len(strText) + 1
hMemory = GlobalAlloc(GMEM_MOVABLE Or _
GMEM_DDESHARE, lngSize)
If Not CBool(hMemory) Then
varRet = CVErr(CANNOTGLOBALALLOC)
GoTo SetTextDone
End If

' Lock the object into memory
lpMemory = GlobalLock(hMemory)
If Not CBool(lpMemory) Then
varRet = CVErr(CANNOTGLOBALLOCK)
GoTo SetTextGlobalFree
End If

' Move the string into the memory we locked
Call MoveMemory(lpMemory, strText, lngSize)

' Don't send clipboard locked memory.
Call GlobalUnlock(hMemory)

' Open the clipboard
If Not CBool(OpenClipboard(0&)) Then
varRet = CVErr(CANNOTOPENCLIPBOARD)
GoTo SetTextGlobalFree
End If

' Remove the current contents of the clipboard
If Not CBool(EmptyClipboard()) Then
varRet = CVErr(CANNOTEMPTYCLIPBOARD)
GoTo SetTextCloseClipboard
End If

' Add our string to the clipboard as text
If Not CBool(SetClipboardData(CF_TEXT, _
hMemory)) Then
varRet = CVErr(CANNOTSETCLIPBOARDDATA)
GoTo SetTextCloseClipboard
Else
fSetClipboardData = True
End If

SetTextCloseClipboard:
' Close the clipboard
If Not CBool(CloseClipboard()) Then
varRet = CVErr(CANNOTCLOSECLIPBOARD)
End If

SetTextGlobalFree:
If Not fSetClipboardData Then
'If we have set the clipboard data, we no longer own
' the object--Windows does, so don't free it.
If CBool(GlobalFree(hMemory)) Then
varRet = CVErr(CANNOTGLOBALFREE)
End If
End If

SetTextDone:
SetText = varRet
End Function

Public Function GetText() As Variant
Dim hMemory As Long
Dim lpMemory As Long
Dim strText As String
Dim lngSize As Long
Dim varRet As Variant

varRet = ""

' Is there text on the clipboard? If not, error out.
If Not CBool(IsClipboardFormatAvailable _
(CF_TEXT)) Then
varRet = CVErr(CLIPBOARDFORMATNOTAVAILABLE)
GoTo GetTextDone
End If

' Open the clipboard
If Not CBool(OpenClipboard(0&)) Then
varRet = CVErr(CANNOTOPENCLIPBOARD)
GoTo GetTextDone
End If

' Get the handle to the clipboard data
hMemory = GetClipboardData(CF_TEXT)
If Not CBool(hMemory) Then
varRet = CVErr(CANNOTGETCLIPBOARDDATA)
GoTo GetTextCloseClipboard
End If

' Find out how big it is and allocate enough space
' in a string
lngSize = GlobalSize(hMemory)
strText = Space$(lngSize)

' Lock the handle so we can use it
lpMemory = GlobalLock(hMemory)
If Not CBool(lpMemory) Then
varRet = CVErr(CANNOTGLOBALLOCK)
GoTo GetTextCloseClipboard
End If

' Move the information from the clipboard memory
' into our string
Call MoveMemory(strText, lpMemory, lngSize)

' Truncate it at the first Null character because
' the value reported by lngSize is erroneously large
strText = Left$(strText, InStr(1, strText, Chr$(0)) - 1)

' Free the lock
Call GlobalUnlock(hMemory)

GetTextCloseClipboard:
' Close the clipboard
If Not CBool(CloseClipboard()) Then
varRet = CVErr(CANNOTCLOSECLIPBOARD)
End If

GetTextDone:
If Not IsError(varRet) Then
GetText = strText
Else
GetText = varRet
End If
End Function

Public Function ErrorText(ByVal lngError As Long) As String
' Reports an error received from the clipboard
'
' From Access 2000 Developer's Handbook, Volume I
' by Getz, Litwin, and Gilbert. (Sybex)
' Copyright 1999. All Rights Reserved.
'

Select Case CInt(lngError)
Case CLIPBOARDFORMATNOTAVAILABLE
ErrorText = "Clipboard format not available"
Case CANNOTOPENCLIPBOARD
ErrorText = "Cannot open clipboard"
Case CANNOTGETCLIPBOARDDATA
ErrorText = "Cannot get clipboard data"
Case CANNOTGLOBALLOCK
ErrorText = "Cannot global lock data"
Case CANNOTCLOSECLIPBOARD
ErrorText = "Cannot close clipboard"
Case CANNOTGLOBALALLOC
ErrorText = "Cannot global alloc"
Case CANNOTEMPTYCLIPBOARD
ErrorText = "Cannot empty clipboard"
Case CANNOTSETCLIPBOARDDATA
ErrorText = "Cannot set clipboard data"
Case CANNOTGLOBALFREE
ErrorText = "Cannot global free"
Case Else
ErrorText = "Unknown error"
End Select
End Function
********************************************************
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) _
As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "user32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long

Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Option Explicit

Function ClipBoard_SetData(MyString As String)



Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, x As Long

' Allocate movable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)

' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox &quot;Could not unlock memory location. Copy aborted.&quot;
GoTo OutOfHere2
End If

' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox &quot;Could not open the Clipboard. Copy aborted.&quot;
Exit Function
End If

' Clear the Clipboard.
x = EmptyClipboard()

' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

If CloseClipboard() = 0 Then
MsgBox &quot;Could not close Clipboard.&quot;
End If

End Function

 

[paulfain]

I've added the modules and recompiled the project without difficulty. When I start the event procedure, everything seems to be working but I eventually get a MS error message box which reads &quot;Object Doesn't Support This Property or Method&quot;

I appreciate any further help you can give me.

Thank you.