'Crea un módulo nuevo y pega este código. Nombre: basCopiarAPortapapeles

Option Compare Database
Option Explicit

Private Const GHND = &H42
Private Const MAXSIZE = 4096
Private Const CF_TEXT = 1

Private Declare Function GlobalAlloc Lib "kernel32" _
        (ByVal wFlags&, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" _
        (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" _
        (ByVal wFormat As Long, ByVal hMem As Long) As Long

Sub Demomc_CopiarAPortapapeles()

    Call mc_CopiarAPortapapeles("¡¡ Hola Mundo !!")

End Sub

Public Function mc_CopiarAPortapapeles(strTextoCopiar As String, _
                                    Optional blnMensajes As Boolean = False)

'La sintaxis de la función consta de estos argumentos:
'Parte                          Descripción
'-------------------------------------------------------------------------------------------
'strTextoCopiar:    Requerido.  Cadena para copiar al portapapeles.
'blnMensajes:       Opcional.   Indicar con un mensaje emergente el error en caso de _
                                producirse. False en caso de faltar el parámetro.

'Última actualización: : 12/04/2002
'Por: www.iespana.es/McPegasus

'From: "alabarta" <alabarta@inicia.es>
'Newsgroups: es.comp.bd.ms -Access
'Subject: RE: Portapapeles
'Date: Tue, 09 Apr 2002 21:59:29 GMT

    Dim hGlobalMemory As Long
    Dim lpGlobalMemory As Long
    Dim hClipMemory As Long
    Dim intError As Integer
    Dim strError As String
    
    hGlobalMemory = GlobalAlloc(GHND, Len(strTextoCopiar) + 1)
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    lpGlobalMemory = lstrcpy(lpGlobalMemory, strTextoCopiar)
  
    If GlobalUnlock(hGlobalMemory) <> 0 Then
        intError = 1
        GoTo OutOfHere2
    End If
  
    If OpenClipboard(0&) = 0 Then
        intError = 2
        GoTo Salida
    End If
  
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

    If CloseClipboard() = 0 Then
        intError = 3
    End If

Salida:
    If blnMensajes = True And Not intError = 0 Then
        Select Case intError
            Case 1
                strError = "No se puede liberar la memoria."
            Case 2
                strError = "No se puede abrir el portapapeles."
            Case 3
                strError = "No se puede cerrar el portapapeles."
        End Select
        DoCmd.Beep
        MsgBox strError, vbInformation + vbOKOnly, "McPegasus informa."
    End If

End Function