Newsgroup: it.comp.appl.access
Titolo: Come copiare il contenuto di una casella di testo negli appunti ?

Cioe' fare ctrl+c con un click sulla casella di testo ?
Grazie, Stefano

 Grazie, Stefano
Perchč vorresti fare ciň?
Antonio

> Cioe' fare ctrl+c con un click sulla casella di testo ?
Interessa anche a me.
Toni


Ti accludo un modulo creato da Peter Strong e modificato da me che contiene
delle funzioni per fare quello che desideri.
Salvalo in un nuovo modulo pubblico.
Per chiamare la funzione che ti copia i dati di un controllo nella clipboard
puoi eseguire per esempio al clic del mouse sul controllo:
pas_SetClipboard(Me!NomeControllo.Value)
Per incollare il contenuto degli appunti:
pas_GetClipBoard()
Ciao, Carlo
Option Compare Database
Option Explicit
Declare Function pas_lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal
lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function pas_GlobalLock Lib "kernel32" Alias "GlobalLock" (ByVal
hMem As Long) As Long
Declare Function pas_GlobalUnlock Lib "kernel32" Alias "GlobalUnlock" (ByVal
hMem As Long) As Long
Declare Function pas_GlobalAlloc Lib "kernel32" Alias "GlobalAlloc" (ByVal
wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function pas_OpenClipboard Lib "user32" Alias "OpenClipboard" (ByVal
hwnd As Long) As Long
Declare Function pas_SetClipboardData Lib "User32.dll" Alias
"SetClipboardData" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Declare Function pas_CloseClipboard Lib "user32" Alias "CloseClipboard" ()
As Long
Declare Function pas_EmptyClipboard Lib "user32" Alias "EmptyClipboard" ()
As Long
Declare Function pas_GetClipboardData Lib "user32" Alias "GetClipboardData"
(ByVal wFormat As Long) As Long
Public Const pas_CF_TEXT = 1
Public Const pas_GMEM_MOVEABLE = &H2
Public Const pas_GMEM_ZEROINIT = &H40
Public Const pas_GHND = (pas_GMEM_MOVEABLE Or pas_GMEM_ZEROINIT)
Public Const pas_MAXSIZE = 4096
Function pas_PasteHeader()
'==========================================================================
'Project      : Top&Tail
'Description  : Adds Header and Footer by calling clipboard functions
'Called By    : Autokeys macro
'Calls        : pas_GetClipBoard, pas_SetClipboard
'Parameters   : none
'Returns      : nothing
'Author       : Peter Strong, modificato da Carlo Costarella
'Date Created : 26/02/98 11:52:32; 20/11/2002
'Rev. History :
'Comments     :
'==========================================================================
On Error GoTo pas_PasteHeaderError
Dim strModuleText As String
Dim strProcName As String
Dim strProcType As String
Dim varClip
varClip = pas_GetClipBoard()
'make sure that there is a selection - chceck it isn't unreasonably long
If Not (varClip = "" Or IsNull(varClip) Or Len(varClip) > 30) Then
    'attempt to identify context of procedure to determine if it is a sub or
function
    Select Case Left(varClip, 3)
        Case "fnc"
            strProcName = varClip
            strProcType = "Function"
        Case "sub", "cmd", "btn", "txt", "lbl", "lst", "cbo", "grp", "opt",
"chk", "frm", "ole", "rec", "sfr", "for"
            strProcName = varClip
            strProcType = "Sub"
        Case Else
            strProcName = varClip
            strProcType = "PROCTYPE"
    End Select
Else
    strProcName = "PROCNAME"
    strProcType = "PROCTYPE"
End If
'define header and footer - make your changes here if required
strModuleText =
"'==========================================================================
"
strModuleText = strModuleText & Chr$(13) & "'Project      : Project Name"
strModuleText = strModuleText & Chr$(13) & "'Description  : "
strModuleText = strModuleText & Chr$(13) & "'Called By    : "
strModuleText = strModuleText & Chr$(13) & "'Calls        : "
strModuleText = strModuleText & Chr$(13) & "'Parameters   : "
strModuleText = strModuleText & Chr$(13) & "'Returns      : "
strModuleText = strModuleText & Chr$(13) & "'Author       : Peter Strong"
' & CurrentUser()
strModuleText = strModuleText & Chr$(13) & "'Date Created : " & Now
strModuleText = strModuleText & Chr$(13) & "'Rev. History : "
strModuleText = strModuleText & Chr$(13) & "'Comments     : Header block and
error handler added using Top&Tail.mda"
strModuleText = strModuleText & Chr$(13) & "'             : (c)1998 Iris
Consultig Ltd (
www.iricon.com
)"
strModuleText = strModuleText & Chr$(13) &
"'==========================================================================
"
strModuleText = strModuleText & Chr$(13) & "On Error GoTo Err_" &
strProcName
strModuleText = strModuleText & Chr$(13) & ""
strModuleText = strModuleText & Chr$(13) & "Dim strActiveObjectName As
String"
strModuleText = strModuleText & Chr$(13) & "strActiveObjectName =
Application.CurrentObjectName &  " & Chr(34) & "|" & strProcName & Chr(34)
strModuleText = strModuleText & Chr$(13) & ""
strModuleText = strModuleText & Chr$(13) & ""
strModuleText = strModuleText & Chr$(13) & ""
strModuleText = strModuleText & Chr$(13) & "Exit_" & strProcName & ":"
strModuleText = strModuleText & Chr$(13) & "    Exit " & strProcType
strModuleText = strModuleText & Chr$(13) & ""
strModuleText = strModuleText & Chr$(13) & "Err_" & strProcName & ":"
strModuleText = strModuleText & Chr$(13) & "    'Error Handler"
strModuleText = strModuleText & Chr$(13) & "    MsgBox " & Chr(34) & "An
error has occured in " & Chr(34) & " & strActiveObjectName & " & Chr(34) & "
.  " & Chr(34) & " & Chr$(13) & Err.Number & " & Chr(34) & " : " & Chr(34) &
" & Err.Description"
strModuleText = strModuleText & Chr$(13) & "    Resume Exit_" & strProcName
strModuleText = strModuleText & Chr$(13) & ""
'set the clipboard data
pas_SetClipboard (strModuleText)
pas_PasteHeaderExit:
    Exit Function
pas_PasteHeaderError:
    MsgBox "Unexpected error in routine: ""pas_PasteHeader"".  Error code: "
& Err & ", " & Error$, 16
    Resume pas_PasteHeaderExit
End Function
Function pas_GetClipBoard()
'==========================================================================
'Project      : Top&Tail
'Description  : Returns the contents of the clipboard
'Called By    : pas_PasteHeader()
'Calls        : Several API calls
'Parameters   : none
'Returns      : contents of the clipboard
'Author       : Peter Strong
'Date Created : 28/02/98 11:50:38
'Rev. History :
'Comments     : restructured from MS KB article Q138910
'Modificato da  Carlo Costarella
'==========================================================================
On Error GoTo Err_pas_GetClipBoard
Dim strActiveObjectName As String
strActiveObjectName = Application.CurrentObjectName & "|fncGetClipBoardData"
Dim hClipMemory As Long
Dim lpClipMemory As Long
Dim MyString As String
Dim lngRetVal As Long
If pas_OpenClipboard(0&) <> 0 Then
    ' Obtain the handle to the global memory block that is referencing the
text
    hClipMemory = pas_GetClipboardData(pas_CF_TEXT)
    If Not IsNull(hClipMemory) Then
        'Lock Clipboard memory so we can reference the actual data string
        lpClipMemory = pas_GlobalLock(hClipMemory)
        If Not IsNull(lpClipMemory) Then
            MyString = Space$(pas_MAXSIZE)
            lngRetVal = pas_lstrcpy(MyString, lpClipMemory)
            lngRetVal = pas_GlobalUnlock(hClipMemory)
            'Trim the null terminating character
            MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
        Else
            MsgBox "Non posso trovare la locazione di memoria per leggere il
contenuto."
        End If
    Else
        MsgBox "Could not allocate memory"
    End If
Else
    MsgBox "Non posso aprire gli appunti. Un'altra applicazione li sta
usando"
End If
Exit_pas_GetClipBoard:
    lngRetVal = pas_CloseClipboard()
    pas_GetClipBoard = MyString
    Exit Function
Err_pas_GetClipBoard:
    'Error Handler Goes Here
    MsgBox "Errore inaspettato: " & strActiveObjectName & " .  Codice
errore: " & Err & ", " & Error$, 16
    Resume Exit_pas_GetClipBoard
End Function
Function pas_SetClipboard(MyString As String)
'==========================================================================
'Project      : Top&Tail
'Description  : Sets the clipboard contents
'Called By    : pas_PasteHeader()
'Calls        : Several API calls
'Parameters   : MyString as string -  this is what goes into clipboard
'Returns      : nothing
'Author       : Peter Strong
'Date Created : 29/04/98 11:54:42
'Rev. History :
'Comments     : restructured from MS KB article Q138909
'Modificata da: Carlo Costarella 
carloco...@libero.it
'==========================================================================
On Error GoTo Err_pas_SetClipboard
Dim strActiveObjectName As String
strActiveObjectName = Application.CurrentObjectName & "|fncTopandTail"
Dim lngGlobalMemory As Long
Dim lngGlobalMemoryFP As Long
Dim lngClipMemory As Long
Dim lngRetVal As Long
'Allocate moveable global memory
lngGlobalMemory = pas_GlobalAlloc(pas_GHND, Len(MyString) + 1)
' Lock the block to get a far pointer  to this memory
lngGlobalMemoryFP = pas_GlobalLock(lngGlobalMemory)
' Copy the string to this global memory
lngGlobalMemoryFP = pas_lstrcpy(lngGlobalMemoryFP, MyString)
' Unlock the memory
If pas_GlobalUnlock(lngGlobalMemory) = 0 Then
    ' Open the Clipboard to copy data to
    If pas_OpenClipboard(0&) <> 0 Then
        ' Clear the Clipboard
        lngRetVal = pas_EmptyClipboard()
        ' Copy the data to the Clipboard
        lngClipMemory = pas_SetClipboardData(pas_CF_TEXT, lngGlobalMemory)
    Else
        MsgBox "Non posso aprire gli appunti. La copia è fallita.",
vbCritical, "Top && Tail"
    End If
Else
    MsgBox "Non posso usare la memoria per copiare. La copia è fallita.",
vbCritical, "Top & Tail"
End If
Exit_pas_SetClipboard:
    If pas_CloseClipboard() = 0 Then
        MsgBox "Non posso chiudere gli appunti.", vbCritical, "Top & Tail"
    End If
    Exit Function
Err_pas_SetClipboard:
    'Error Handler Goes Here
    MsgBox "Errore inaspettato: " & strActiveObjectName & " .  Codice
errore: " & Err & ", " & Error$, 16
    Resume Exit_pas_SetClipboard
End Function
Public Function fncTopandTail()
'==========================================================================
'Project      : Top&Tail
'Purpose      : Loads the Autokeys Macro and this module into your Working
MDB
'Called By    : Startup of MDA
'Parameters   : none
'Returns      : nothing
'Author       : Peter Strong
'Date Created : 26/02/98 10:32:55
'Rev. History :
'Comments     :
'==========================================================================
On Error GoTo Err_fncTopandTail
Dim strActiveObjectName As String
strActiveObjectName = Application.CurrentObjectName & "|fncTopandTail"
DoCmd.OpenForm "frmIntro"
Exit_fncTopandTail:
    Exit Function
Err_fncTopandTail:
    'Error Handler Goes Here
    MsgBox "Unexpected error in routine: " & strActiveObjectName & " .
Error code: " & Err & ", " & Error$, 16
    Resume Exit_fncTopandTail
End Function

 Grazie, Stefano
Sposta il fuoco sulla casella di testo ed usando l'istruzione SendKeys (vedi
help) invia un Ctrl+C, ovvero una cosa del genere:
SendKeys "^C"
--
Roberto
---------------------------------------------
il Sito Comune di it.comp.appl.access:
http://www.sitocomune.com
---------------------------------------------


Scusami la c deve essere minuscola e non maiuscola:
SendKeys "^c", True


 SendKeys "^c", True
http://groups.google.com/groups?&selm=bd4ec4$ooirm$1...@ID-46617.news.dfncis.de
-- 
cu
Karl
*********
Access-FAQ (tedesco): 
http://www.donkarl.com

 wrote in message
bhvld2$3mtdr$1...@ID-46617.news.uni-berlin.de...

OK
