|
|
楼主 |
发表于 2012-9-23 22:54
|
显示全部楼层
本帖最后由 win2009 于 2012-10-1 00:52 编辑
关于剪切板的内容整理一下先运行一下 注册控件 以防未注册提示
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&)) 那么
调用 清空剪切板
调用 关闭剪切板
结束 如果
结束 过程
|
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-9-23 22:24
