唯一能清空剪切板的 api 函数 附赠liulanqi

win2009

测试了各种办法，都不能清空剪切板，不信就试试
1:Application.CutCopyMode = False的作用是退出复制、粘贴模式，有人说是清空粘贴板，我不知道是不是。
2:Clipboard.Clear         '清除剪贴板上的内容
3:Clipboard.SetText ""

'
网址：http://hi.baidu.com/ymxlsxfobbbnrxq/item/57760c063d154aca905718b6
标题：使用API完全清空剪贴板_My VBA_百度空间

这是使用API函数来完全清空剪贴板内容的一个方法，在此记下，以备后用。
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Sub EraseClipboard()
    If (OpenClipboard(0&)) Then
        Call EmptyClipboard
        Call CloseClipboard
    End If
End Sub

私有的 声明 函数 打开剪切板 引用库 "user32" (传值变量 句柄 为 长整型值) 为 长整型值
私有的 声明 函数 关闭剪切板 引用库 "user32" () 为 长整型值
私有的 声明 函数 清空剪切板 引用库 "user32" () 为 长整型值
过程 eraseclipboard()
    如果 (打开剪切板(0&)) 那么
        调用 清空剪切板
        调用 关闭剪切板
    结束 如果
结束 过程



==================
2012-9-23 21:55:37
==================
新版光速浏览器，一键保存网页选定区域的内容为文本，到工作簿路径下，且自动以当日时间命名
每天只生成一个，选定内容在校窗体查看，..............
放在这里，备用，加载宏

win2009

关于剪切板的内容整理一下先运行一下  注册控件 以防未注册提示

Sub 注册控件()
    Dim d
    On Error Resume Next
    d = Shell("regsvr32 C:\Windows\system32\scrrun.dll")
End Sub

过程 注册控件()
定义变量 d
当 错误 转到 下一句
d = 运行程序("regsvr32 c:\windows\system32\scrrun . dll")
结束 过程

    VBA EXCEL实现剪切、复制、粘贴
    Selection.Cut
    Selection.copy
    Selection.Paste
一下虚线内的内容有误，可能原作者未做测试，或转载遗失数据修改一下就行了

'________________________________________________________________________________________
***就是这段不行：
用 SetText 和 GetText 方法向剪贴板和从剪贴板传送数据
注：Clipboard 就是剪切板的vba 代码
SetText 将文本复制到 Clipboard 上，替换先前存储在那里的文本。可将 SetText 作为一条语句使用。其语法如下：
Clipboard.SetText data[, format]
GetText 返回存储在 Clipboard 上的文本。也可将它作为函数使用：
destination = Clipboard.GetText()
将 SetText 和 GetText 方法，和“使用选定文本”中介绍的选择属性结合起来使用，可容易地编写文本框的“复制”，“剪切”和“粘贴”命令。下列一些事件过程，为以 mnuCopy，mnuCut 和 mnuPaste 命名的控件，实现了这些命令：
Private Sub mnuCopy_Click ()
   Clipboard.SetText Text1.SelText
End Sub

Private Sub mnuPaste_Click ()
   Text1.SelText = Clipboard.GetText()
End Sub
'______________________________________________________________________________
修改为如下：
'先建立一个窗体，添加2个文本框，1个按钮
'将下列代码写入窗体里
++++++++++++++++++++++++++++++++++++++
Private Sub CommandButton1_Click()
    Set cp = New DataObject           
    cp.SetText TextBox1.Text         
    cp.PutInClipboard
    TextBox2.SelText = cp.GetText()   
End Sub
Private Sub UserForm_Initialize()
    TextBox1 = "这是测试剪切板测试过程的窗体，作者win_2009"
End Sub

私有的 过程 命令按钮1单击()
    设置 cp = 新的 数据对象           
    cp . set文本 文本框1 . 文本         
    cp . 存放于剪切板
    文本框2 . 所选文本的字符串 = cp . 获得文本()   
结束 过程
私有的 过程 窗体初始化()
    文本框1 = "这是测试剪切板测试过程的窗体  ，作者win_2009"
结束 过程

++++++++++++++++++++++++++++++++++++++

怎样操作剪切板

1、先得添加一个 Form，只要添加一个空的就好了，因为后面所用到的 DataObject 对象，需要Form对象；
   在VBA编辑器中点菜单：插入 -> 用户窗体，即可；
2、在你的模块中放入如下示例代码：
Sub Test()
    Dim MyData As DataObject, MyStr As String
    Set MyData = New DataObject
    MyData.GetFromClipboard    '获得剪切板内容
    MyStr = MyData.GetText     '赋值给变量
    MsgBox MyStr
End Sub
过程 test()
定义变量 mydata 为 数据对象    mystr 为 string
设置 mydata = 新的 数据对象
mydata . getfromclipboard
mystr = mydata . 获得文本
消息框： mystr
结束 过程

'________________________________________________________________________

'这是使用API函数来完全清空剪贴板内容的一个方法
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Sub 用记事本打开剪切版数据()
    On Error Resume Next
    Dim MyData As DataObject, MyStr As String, a
    Set MyData = New DataObject
    MyData.GetFromClipboard   
    MyStr = MyData.GetText     
    a = Split(MyStr, vbCrLf)
    For i = 0 To UBound(a)
        If Len(a(i)) <> 0 Then
            c = c & a(i) & vbCrLf
        End If
    Next
    Dim Filename As String
    Dim Data As String
    Arr = c
    Filename = "C:\test.txt"     
    Open Filename For Output As #1
    Data = Arr
    Print #1, (Data)
    Close #1
    Shell "notepad C:\test.txt", vbNormalFocus   
    If (OpenClipboard(0&)) Then
        Call EmptyClipboard
        Call CloseClipboard
    End If
End Sub

私有的 声明 函数 打开剪切板 引用库 "user32" (传值变量 hwnd 为 长整型值) 为 长整型值
私有的 声明 函数 关闭剪切板 引用库 "user32" () 为 长整型值
私有的 声明 函数 清空剪切板 引用库 "user32" () 为 长整型值
私有的 过程 用记事本打开剪切版数据()
    当 错误 转到 下一句
    定义变量 mydata 为 数据对象 ,mystr 为 字符串 ,a
    设置 mydata = 新的 数据对象
    mydata . getfromclipboard   
    mystr = mydata . 获得文本     
    a = 分割字符串(mystr ,回车换行符)
    循环范围 i = 0 到 数组上限(a)
        如果 字符串长度(a(i))<>0 那么
            c = c & a(i) & 回车换行符
        结束 如果
    下一句
    定义变量 文件名 为 字符串
    定义变量 数据 为 字符串
    arr = c
    文件名 = "c:\test . txt"     
    打开文件 文件名 循环范围 顺序输出 为 #1
    数据 = arr
    输出显示 #1 ,(数据)
    关闭 #1
    运行程序 "notepad c:\test . txt" ,vbnormalfocus   
    如果 (打开剪切板(0&)) 那么
        调用 清空剪切板
        调用 关闭剪切板
    结束 如果
结束 过程

liucqa

如果你清除剪贴板的目的是避免Excel关闭工作簿的时候出现提示，那么直接用range("A1").copy就行，不必把剪贴板都清空，这会影响其他进程的工作的

引子玄

测试完成，使用这段代码后（4次晴空），提速6秒

win2009

'先引用“MicroSoft Scriping Runtime”
Public Sub 数据读入str()
    Dim fso As New Scripting.FileSystemObject   
    Dim fil As Scripting.File
    Dim tex As Scripting.TextStream
    Dim str As String
    Set fil = fso.GetFile("D:\test.txt")   
    Set tex = fil.OpenAsTextStream(Format:=TristateFalse)   
                                                                                            
    str = tex.ReadAll()   
    MsgBox str
End Sub
公有的 过程 数据读入str()
定义变量 fso 为 新的 scripting . filesystemobject
定义变量 fil 为 scripting . file
定义变量 tex 为 scripting . textstream
定义变量 str 为 字符串
设置 fil = fso . getfile("d:\test . txt")
设置 tex = fil . openastextstream(格式化输出 := tristatefalse)
str = tex . 方法()
消息框： str
结束 过程

win2009

Public Sub 数据读入str()
    Dim fso As New Scripting.FileSystemObject
    Dim fil As Scripting.File
    Dim tex As Scripting.TextStream
    Dim str As String
    Set fil = fso.GetFile("D:\test.txt")
    Set tex = fil.OpenAsTextStream(Format:=TristateFalse)
    str = tex.ReadAll()
    c = Split(str, vbCrLf)
    For i = 0 To UBound(c)
        If Len(c(i)) > 0 Then
            st = st & c(i) & vbCrLf
        End If
    Next
    MsgBox st
End Sub
Public Sub 添加写入()
    Dim str
    str = "VBS的filesystemobject对象在VBA里使用"
    Set abc = CreateObject("scripting.filesystemobject")
    Set ntxt = abc.OpenTextFile("D:\test.txt", 8, True)
    ntxt.WriteLine str
    ntxt.Close
    Set abc = Nothing
End Sub

Public Sub 添加写入()
    Dim str
   
    str = "VBS的filesystemobject对象在VBA里使用"
    Set abc = CreateObject("scripting.filesystemobject")
    Set ntxt = abc.OpenTextFile("D:\test.txt", 8, True)
    ntxt.WriteLine str        
    ntxt.Close
    Set abc = Nothing
End Sub
公有的 过程 添加写入()
定义变量 str
str = "vbs的filesystemobject对象在vba里使用"
设置 abc = 创建对象("scripting . filesystemobject")
设置 ntxt = abc . 打开文本文件("d:\test . txt"    8    真)
ntxt . 写文本行 str
ntxt . 关闭
设置 abc = 空值
结束 过程

网址：http://baike.baidu.com/view/1229955.htm
标题：OpenTextFile_百度百科

OpenTextFile　　OpenTextFile 方法 　　打开指定的文件并返回一个 TextStream 对象，可以通过这个对象对文件进行读、写或追加。 　　

object.OpenTextFile(filename[, iomode[, create[, format]]]) 　　
参数 　　object 　　必选项。
object 应为 FileSystemObject 的名称。 　
filename 　　必选项。 指明要打开文件的字符串表达式。
iomode 　　可选项。 可以是三个常数之一： ForReading 、 ForWriting 或 ForAppending 。
create 　　可选项。 Boolean 值，指明当指定的 filename 不存在时是否创建新文件。 如果创建新文件则值为 True ，如果不创建则为

False 。 如果忽略，则不创建新文件。 　
format 　　可选项。 使用三态值中的一个来指明打开文件的格式。 如果忽略，那么文件将以 ASCII 格式打开。 　
设置 　　iomode 参数可以是下列设置中的任一种： 　　常数 值 描述 　　ForReading 1 以只读方式打开文件。 不能写这个文件。 　　

ForWriting 2 以写方式打开文件 　　ForAppending 8 打开文件并从文件末尾开始写。 　　
format 参数可以是下列设置中的任一种： 　　值 描述 　　TristateTrue 以 Unicode 格式打开文件。 　　TristateFalse 以 ASCII 格式

打开文件。 　
TristateUseDefault 使用系统默认值打开文件。 　　
说明 　　下面的代码说明了如何使用 OpenTextFile 方法打开文件并追加文本：
var fs, a, ForAppending; 　
ForAppending = 8; 　
fs = new ActiveXObject("Scripting.FileSystemObject"); 　
　//可以是三个常数之一： ForReading 、 ForWriting 或 ForAppending 　　
//分别是 1 ，2 ，8 　　
a = fs.OpenTextFile("c:\\testfile.txt", 1, false); 　
　... 　　
a.Close();

引子玄

win2009 发表于 2012-9-24 01:43
Public Sub 添加写入()
    Dim str
    'VBS的filesystemobject对象在VBA里使用

这么多ＳＵＢ，你说＂唯一能清空剪切板的＂ＳＵＢ，到底选哪个呦？
俺只调用了这一个代码用来清空，行否？

Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Sub EraseClipboard()
    If (OpenClipboard(0&)) Then
        Call EmptyClipboard
        Call CloseClipboard
    End If
End Sub

有时候提速，好象不止０.１分钟，甚至到达１分钟．测试发现已经从３.４分钟提速到了２.３分钟．

win2009

引子玄 发表于 2012-9-24 08:19
这么多ＳＵＢ，你说＂唯一能清空剪切板的＂ＳＵＢ，到底选哪个呦？
俺只调用了这一个代码用来清空，行 ...

对就是这样，这段放在模块顶部：
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
下面的放在任意过程之内
    If (OpenClipboard(0&)) Then
        Call EmptyClipboard
        Call CloseClipboard
    End If

引子玄

win2009 发表于 2012-9-24 08:52
对就是这样，这段放在模块顶部：
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As ...

这段SUB代码我单独放在一个模块里．每次在粘贴的代码后面，就调用这段＂全部清空粘贴板＂的SUB代码．共４次调用，效果还是蛮好的，反正是提速了，用定了．多谢你．

win2009

引子玄 发表于 2012-9-24 08:58
这段代码我单独放在一个模块里．每次在复制粘贴的代码后面，就调用这段＂全部清空粘贴板＂的代码．共４ ...

这段代码，有特定用途，比如，在窗体里有一个文本框，
这个文本框用来粘贴网址，窗体运行后，每次双击文本框内部
就清空并粘贴剪切板上的网址，粘贴完成后立即清空剪切板
就需要这个，代码如下
Private Declare Function OpenClipboard Lib "user32" (ByVal Hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    On Error Resume Next
    ComboBox1 = ""
    Dim MyData As DataObject, MyStr As String, a
    Set MyData = New DataObject
    MyData.GetFromClipboard   
    MyStr = MyData.GetText     
    c = Trim(MyStr)
    ComboBox1 = c
    If (OpenClipboard(0&)) Then
        Call EmptyClipboard
        Call CloseClipboard
    End If
End Sub

私有的 声明 函数 打开剪切板 引用库 "user32" (传值变量 句柄 为 长整型值) 为 长整型值
私有的 声明 函数 关闭剪切板 引用库 "user32" () 为 长整型值
私有的 声明 函数 清空剪切板 引用库 "user32" () 为 长整型值
私有的 过程 组合框1双击(传值变量 窗体值真假 为 msforms . returnboolean)
    当 错误 转到 下一句
    组合框1 = ""
    定义变量 mydata 为 数据对象 ,mystr 为 字符串 ,a
    设置 mydata = 新的 数据对象
    mydata . getfromclipboard   
    mystr = mydata . 获得文本     
    c = 消除两端空格(mystr)
    组合框1 = c
    如果 (打开剪切板(0&)) 那么
        调用 清空剪切板
        调用 关闭剪切板
    结束 如果
结束 过程