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

Additional Support Resources

Articles in this section

Background

Question

Answer

Use this for Reports:

Additional Support Resources