Background
Total Access Memo lets you add rich text format (RTF) memos to Microsoft Access with sophisticated editing and spell checking.
Question
How do I programmatically use the Clipboard with the Total Access Memo control?
Answer
' This code shows how to use the Windows Clipboard with Total Access Memo on Forms. ' ' Declarations and public constants needed to use Copy and Paste via the Windows SendMessage function. ' Private Declare Function SendMessage _ Lib "user32" _ Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Const WM_COPY = &H301 Private Const WM_PASTE = &H302 ' To copy as RTF including objects, you will need to get the long value of the clipboard format for Rich Text. Private Declare Function RegisterClipboardFormat _ Lib "user32" _ Alias "RegisterClipboardFormatA" _ (ByVal lpString As String) As Long Private Const CF_RTF = "Rich Text Format" Private objFMSMemo As FMSMEMO Private Sub Form_Load() ' Get a handle to the memo control Set objFMSMemo = Me.tamDemo.Object End Sub
Sub Copy()
' Comments: Copies the contents of the Total Access Memo control
' to the Windows Clipboard. This subroutine assumes that
' the name of the Total Access Memo control is tamDemo and is
' set to a dimensioned object named "objFMSMemo" in the Form_Load Event.
' If your control is named differently, modify this code.
Dim lngClipboardFormat As Long
' This code sends a Windows Copy message to the Memo control.
If objFMSMemo.SelLength > 0 Then
' RegisterClipboardFormat returns a long value.
' lngClipboardFormat holds the returned value.
lngClipboardFormat = RegisterClipboardFormat(CF_RTF)
' Use the returned value of lngClipboardFormat to specify the type data the clipboard will hold
SendMessage objFMSMemo.hwnd, WM_COPY, lngClipboardFormat, 0
Else
MsgBox "Please select something to copy", vbOKOnly, "FMS Demo"
End If
End Sub
Sub Paste()
' Comments: Copies the contents of the Windows Clipboard to the
' Total Access Memo control. This subroutine assumes that
' the name of the Total Access Memo control is tamTest.
' If your control is named differently, modify this code.
' This code sends a Windows Paste message to the Memo control.
SendMessage objFMSMemo.hwnd, WM_PASTE, 0, 0
End Sub
Use this for Reports:
Option Compare Database Option Explicit
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 GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function CloseClipboard Lib "User32" () As Long
Private Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "User32" () As Long
Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function RegisterClipboardFormat
Lib "User32" Alias "RegisterClipboardFormatA" _
(ByVal lpString As String) As Long
Private Const CF_RTF = "Rich Text Format"
Private Const GHND = &H42
Private Const MAXSIZE = 4096
Private lngClipboardFormat As Long
'Constant for the maximum report height
'This is set by Access at 22 inches
Const MAXREPORTHEIGHT = 31680
Function CopyToClipBoard(strValue As String)
Dim hGlobalMemory As Long
Dim lpGlobalMemory As Long
Dim hClipMemory As Long
Dim x As Long
On Error GoTo PROC_ERR
lngClipboardFormat = RegisterClipboardFormat(CF_RTF)
' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(strValue) + 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, strValue)
' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
End If
' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
End If
' Clear the Clipboard.
x = EmptyClipboard()
' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(lngClipboardFormat, hGlobalMemory)
PROC_EXIT:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
Exit Function
PROC_ERR:
MsgBox Err.Number & " " & Err.Description
Resume PROC_EXIT
End Function
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
tamDemo.SelStart = 0
tamDemo.SelLength = Len(tamDemo.Text)
CopyToClipBoard tamDemo.SelValue
' DO YOUR PASTE INTO OTHER PROGRAM (like MS WORD) here
'
' Continue with HeightOfText from Sample Application.
' ...
End Sub



Comments
0 comments
Please sign in to leave a comment.