复制文本框内容到剪贴板-Grant
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


复制文本框内容到剪贴板

发表时间:2009/2/16 14:13:43 评论(0) 浏览(11400)  评论 | 加入收藏 | 复制
   
摘 要:复制文本框内容到剪贴板
正 文:
SendKeys "{Home}+{End}"
SendKeys "^{c}", True

简单实用.
VBA中用API操作剪贴板

Public Const GHND = &H42
Public Const CF_TEXT = 1
Private Const CF_ANSIONLY = &H400&
Private Const CF_APPLY = &H200&
Private Const CF_BITMAP = 2
Private Const CF_DIB = 8
Private Const CF_DIF = 5
Private Const CF_DSPBITMAP = &H82
Private Const CF_DSPENHMETAFILE = &H8E
Private Const CF_DSPMETAFILEPICT = &H83
Private Const CF_DSPTEXT = &H81
Private Const CF_EFFECTS = &H100&
Private Const CF_ENABLEHOOK = &H8&
Private Const CF_ENABLETEMPLATE = &H10&
Private Const CF_ENABLETEMPLATEHANDLE = &H20&
Private Const CF_ENHMETAFILE = 14
Private Const CF_FIXEDPITCHONLY = &H4000&
Private Const CF_FORCEFONTEXIST = &H10000
Private Const CF_GDIOBJFIRST = &H300
Private Const CF_GDIOBJLAST = &H3FF
Private Const CF_HDROP = 15
Private Const CF_INITTOLOGFONTSTRUCT = &H40&
Private Const CF_LIMITSIZE = &H2000&
Private Const CF_LOCALE = 16
Private Const CF_MAX = 17
Private Const CF_METAFILEPICT = 3
Private Const CF_NOFACESEL = &H80000
Private Const CF_NOSCRIPTSEL = &H800000
Private Const CF_NOSIMULATIONS = &H1000&
Private Const CF_NOSIZESEL = &H200000
Private Const CF_NOSTYLESEL = &H100000
Private Const CF_NOVECTORFONTS = &H800&
Private Const CF_NOOEMFONTS = CF_NOVECTORFONTS
Private Const CF_NOVERTFONTS = &H1000000
Private Const CF_OEMTEXT = 7
Private Const CF_OWNERDISPLAY = &H80
Private Const CF_PALETTE = 9
Private Const CF_PENDATA = 10
Private Const CF_PRINTERFONTS = &H2
Private Const CF_PRIVATEFIRST = &H200
Private Const CF_PRIVATELAST = &H2FF
Private Const CF_RIFF = 11
Private Const CF_SCALABLEONLY = &H20000
Private Const CF_SCREENFONTS = &H1
Private Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Private Const CF_SCRIPTSONLY = CF_ANSIONLY
Private Const CF_SELECTSCRIPT. = &H400000
Private Const CF_SHOWHELP = &H4&
Private Const CF_SYLK = 4
Private Const CF_TIFF = 6
Private Const CF_TTONLY = &H40000
Private Const CF_UNICODETEXT = 13
Private Const CF_USESTYLE = &H80&
Private Const CF_WAVE = 12
Private Const CF_WYSIWYG = &H8000
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 lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) 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
Public Sub ClearClipBoard()
    OpenClipboard 0&
    EmptyClipboard
    CloseClipboard
End Sub
Function ClipBoard_SetText(strCopyString As String) As Boolean
    Dim hGlobalMemory As Long
    Dim lpGlobalMemory As Long
    Dim hClipMemory As Long
    Call ClearClipBoard
    hGlobalMemory = GlobalAlloc(GHND, Round((Len(strCopyString) / 1024 + 0.5), 0) * 1024)
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    lpGlobalMemory = lstrcpy(lpGlobalMemory, strCopyString)
    If GlobalUnlock(hGlobalMemory) = 0 Then
      If OpenClipboard(0&) <> 0 Then
        hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
        ClipBoard_SetText = CBool(CloseClipboard)
      End If
    End If
End Function
Function ClipBoard_GetText() As String
    Dim hClipMemory As Long
    Dim lpClipMemory As Long
    Dim strCBText As String
    Dim RetVal As Long
    Dim lngSize As Long
    If OpenClipboard(0&) <> 0 Then
        hClipMemory = GetClipboardData(CF_TEXT)
        If hClipMemory <> 0 Then
            lpClipMemory = GlobalLock(hClipMemory)
            If lpClipMemory <> 0 Then
                lngSize = GlobalSize(lpClipMemory)
                strCBText = Space$(lngSize)
                RetVal = lstrcpy(strCBText, lpClipMemory)
                RetVal = GlobalUnlock(hClipMemory)
                strCBText = Left(strCBText, InStr(1, strCBText, Chr$(0), 0) - 1)
            Else
                MsgBox "Could not lock memory to copy string from."
            End If
        End If
        Call CloseClipboard
    End If
    ClipBoard_GetText = strCBText
End Function
Function CopyOlePiccy(Piccy As Object)
    Dim hGlobalMemory As Long, lpGlobalMemory As Long
    Dim hClipMemory As Long, X As Long
    hGlobalMemory = GlobalAlloc(GHND, Len(Piccy) + 1)
    lpGlobalMemory = GlobalLock(hGlobalMemory)
    lpGlobalMemory = lstrcpy(lpGlobalMemory, Piccy)
    If GlobalUnlock(hGlobalMemory) <> 0 Then
        MsgBox "Could not unlock memory location. Copy aborted."
        GoTo OutOfHere2
    End If
    If OpenClipboard(0&) = 0 Then
        MsgBox "Could not open the Clipboard. Copy aborted."
        Exit Function
    End If
    X = EmptyClipboard()
    hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
    If CloseClipboard() = 0 Then
        MsgBox "Could not close Clipboard."
    End If
End Function

Access软件网交流QQ群(群号:198465573)
 
 相关文章
第100个是铜像---文本框字号自适应列宽  【小英  2013/3/2】
文本框记住值示例  【杜超  2013/5/18】
【Access基础】判断文本框中是否存在非数字字符/文本框只能输入...  【缪炜  2013/5/24】
Access文本框列表框代替组合框的联动查询  【在水一方  2013/6/25】
采用函数形式实现遍历子窗体文本框模糊查询文本内容  【cspa  2013/7/16】
常见问答
技术分类
相关资源
文章搜索
关于作者

Grant

文章分类

文章存档

友情链接