richtext box to Word then back--now No Hair

[bubba100]

Let me explain what I am working with WindowsXP/OfficeXP except using Access97. Within Access I have a richtext box that will allow the user to change font and bold plus a couple of other features. I have a command button for spell checking. This sends the contents of the box to Word (keeps the formatting of the text) and starts the spell checker, lets you take care of the spelling errors. Then at the end it sends the "corrected" text back to the richtext box. Then the text comes back as plain (without the formatting). That's the problem, I need the formatted text to come back and I don't have enough hair left trying to figure this out.

Most of this code came from hear and Microsoft and I really don't understand much of it. I know need to clean it up but I will take care of that when this is finished.

Any ideas?

This first set of code is on the form.

Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "User32" Alias _
"RegisterClipboardFormatA" (ByVal lpString As String) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function SetClipboardData Lib "User32" ( _
ByVal wformat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "User32" (ByVal wformat As _
Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wflags As Long, _
ByVal dwbytes As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
ByVal destination As Long, source As Any, ByVal length As Long)
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" ( _
ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lstring1 As Any, _
ByVal lstring2 As Any) As Long

Private Const GHND = &O42
Private Const CF_TEXT = 1
Private Const MAXSIZE = 4096
Private Const GMEM_DDESHARE = &H2000
Private Const GMEM_MOVEABLE = &H2


This code is on the command button.

Private Sub cmdSplChk2_Click()
On Error GoTo Err_cmdSplChk2_Click
Dim sRTF As String
sRTF = Me!ActXCtl8
Dim Wrtf As String
Dim lSuccess As Long
Dim lRtf As Long
Dim hGlobal As Long
Dim lpString As Long
Dim lOrgTop As Long
lSuccess = OpenClipboard(Me.hwnd)
lRtf = RegisterClipboardFormat("Rich Text Format")
lSuccess = EmptyClipboard
hGlobal = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, Len(sRTF))
lpString = GlobalLock(hGlobal)
CopyMemory lpString, ByVal sRTF, Len(sRTF)
GlobalUnlock hGlobal
SetClipboardData lRtf, hGlobal
CloseClipboard
GlobalFree hGlobal
Dim oWord As Object
Dim oDoc As Object
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Add
oWord.Visible = True
lOrgTop = oWord.Top
oWord.WindowState = 0
oWord.Top = -3000
oWord.Selection.Paste
oDoc.Activate
oDoc.CheckSpelling

oWord.Selection.WholeStory
oWord.Selection.Copy

Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim mystring As String
Dim Retval As Long

If OpenClipboard(0&) = 0 Then
MsgBox "cannot open Clipboard. Another app. may have it open"
GoTo OutofHere
End If
hClipMemory = GetClipboardData(CF_TEXT)
If IsNull(hClipMemory) Then
MsgBox "Could not allocate memory"
GoTo OutofHere
End If
lpClipMemory = GlobalLock(hClipMemory)

If Not IsNull(lpClipMemory) Then
mystring = Space$(MAXSIZE)
Retval = lstrcpy(mystring, lpClipMemory)
Retval = GlobalUnlock(hClipMemory)
mystring = Mid(mystring, 1, InStr(1, mystring, Chr$(0), 0) - 1)
Else
MsgBox "could not look to copy string from."
End If

OutofHere:
Retval = CloseClipboard()
Me!ActXCtl8 = mystring
With oWord
.ActiveDocument.Close savechanges:=False
.Quit
End With
Exit_cmdSplChk2_Click:
Exit Sub

 

[PHV]

And what about playing with a temporary rtf file ?

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[bubba100]

Thanks PHV. Trying that, from what I can see its going to the clipboard as richtext but I am calling it out as plain.

When I get this figured out I'll let you know.

 

[pcgenie]

I have an alternate solution that involves rich text, if you would like to take a look. It contains 4 tabs on a tabcontrol and each tab has a rich text field. Enter data in any of the rich text fields and click the save icon. Then with the cursor in one of the rich text fields, do a right click and what I have named as my "rtfZoomEditor" pops up with a number of edit buttons that are similar to MS WordPad. You should be able to edit and format your text. To place images, just drag them from their source and drop them in the rich text field. You can also cut and paste them. I would have left images in this sample, but the file size is to large to post in a forum. Let me know how it works for you. I'm still looking for a spell checker that works in rich text. Also I think the "Find" button should highlight all occurances of the word that it has found. I'm still looking for a way to accomplish that. There are still more rich text edit commands that are shown in the object browser for "RichTextLib" that would further enhance this project. If someone can help me with this I'd appreciate it. My prototype db is located at:

http://www.dbforums.com/attachment.php?attachmentid=2727

Here's a couple of links with some more samples I've found for those who are interested.

http://www.access-programmers.co.uk/forums/attachment.php?attachmentid=5545

http://www.dbforums.com/attachment.php?attachmentid=2666

http://www.utteraccess.com/forums/download.php?Number=458369

http://msdn.microsoft.com/library/d...vbcon98/html/vbconusingtheactivexcontrols.asp

PC

 

[strongm]

You are using CF_TEXT (plain text) as the clipboard format to be retrieved. You might want to try using CF_RTFTEXT. Here's its definition:

CF_RTFTEXT=&HFFFFBF01&

 

[pcgenie]

I tried making the changes you recommended and I can't seem to get the module to work right. Please verify that I'm doing it correctly. I changed "Private Const CF_TEXT = 1" to "Private Const CF_RTFTEXT=&HFFFFBF01&" and changed "hClipMemory = GetClipboardData(CF_TEXT)" to
"hClipMemory = GetClipboardData(CF_RTFTEXT)" and then tried the spellchecker. Doing this gave me an error. Please advise.

Thanks.

PC