用VBA操作Office剪贴板

sylun

这两天对用VBA操作Office剪贴板的问题产生了兴趣。VBA帮助文件对此好像并无多少提及，在网上进行过一系列的搜索，基本上是用API来操作的，只因水平所限，看不明白，便试着用别的方法处理。经反复尝试，总算有些眉目，主要是用SendKeys语句处理的，经多次测试（Word2003），似可行。这样的操作可能实用意义不大，只是作为练习，也算有点收获。
以下为相关代码，欢迎测试，并提出修改意见。

Sub test1()
'检查Office剪贴板现有粘贴项目
Dim a As String
With CommandBars("Task Pane")
    WordBasic.editofficeclipboard  '从任务窗格调出剪贴板
    With .Controls(1)
        a = .Caption  '提取Office剪贴板控件的题注文本
        If a Like "24*" Then
            MsgBox "Office剪贴板粘贴项目已满24个！"
        ElseIf a Like "#*" Then
            MsgBox "Office剪贴板现有" & Split(a, "/")(0) & "个粘贴项目。"
        Else
            MsgBox "Office剪贴板是空的！"
        End If
    End With
End With
End Sub

Sub test2()
'操作Office剪贴板（全部粘贴或全部清空，以及对指定粘贴项目的粘贴或删除操作）
Dim b As Byte, c As String
Application.ScreenUpdating = False
With CommandBars("Task Pane")
    WordBasic.editofficeclipboard
    With .Controls(1)
        b = Val(Split(.Caption, "/")(0))  '取得Office剪贴板现有粘贴项目数
        If b > 0 Then
            c = InputBox("Office剪贴板现有" & b & "个粘贴项目。" & vbCrLf & vbCrLf _
                & "请输入要粘贴的项目序号，直接按回车粘贴全部，输入0全部清空", , "全部")
            If c = "全部" Then
                .SetFocus  '焦点移到任务窗格（剪贴板）
                SendKeys "{LEFT 3}", False  '定位到第一个粘贴项（最上面的项，即最后复制的项）
                SendKeys "{TAB 2}", True  '定位到“全部粘贴”
                SendKeys "{ }", False  '执行全部粘贴
            ElseIf Val(c) > 0 And Val(c) <= b Then
                .SetFocus
                SendKeys "{LEFT 3}", False
                SendKeys "{DOWN " & Val(c) - 1 & "}", False '定位到指定的粘贴项目
                SendKeys "%{DOWN 2}", False  '在指定的粘贴项目下拉菜单选择“粘贴”项（前面数字改为3即“删除”项）
                SendKeys "{ENTER}", False  '执行粘贴（前面数字为3时执行删除）
            ElseIf Val(c) = 0 Then
                .SetFocus
                SendKeys "{LEFT 3}", False
                SendKeys "{TAB 3}", True  '焦点定位到“全部清空”
                SendKeys "{ }", False  '执行全部清空
            End If
        Else
            MsgBox "Office剪贴板是空的！"
        End If
    End With
End With
SendKeys "{ESC 2}", False  '焦点从任务窗格返回文档
Application.ScreenUpdating = True
End Sub

[ 本帖最后由 sylun 于 2009-1-2 16:49 编辑 ]

守柔

谢谢sylun兄的分享！
sendkeys方法实际上的确是不得以而为之。
一般比较正规的方法，还是用API 的SendMessage函数比较容易控制（定向发送指令），而且这个函数功能太强大了。

sylun

谢谢老大关注。
确实，SendKeys语句只是模拟键盘操作，其执行效果带有不确定性。比如，如果有关对象的Visible属性为False或相关窗口为最小化状态时，执行会失灵或出错。因此，这确属权宜之计。
API函数较复杂，还没碰过，估计要有一定编程基础才能用，不像SendKeys语句那样易于理解。

hhzjxss

谢谢，这是Word中的，跟excel好象有些差别！

冲天妖狐

运行时错误“424”
要求对象

代码    WordBasic.editofficeclipboard  '从任务窗格调出剪贴板

martingsyang

感谢楼主的分享。

工作中有部分工作要从另一个系统copy内容然后paste 到word 里面，各个粘贴的项目用Tab键来隔开，因为需要重复的粘贴，试着用楼主的方法改了一下VBA，效率应该能提高显著。只是改动了一下，出现了个问题一直找不到原因，
-- 粘贴的项目最多只能是四个，超过四个之后，顺序就会乱了。
不知哪位大侠能给指点一下。

尝试了去找原因：
1、i 变量如果定义为byte, 会出现“溢出”的错误提示，只能改为integer 或者long, 不知这个是否会影响
2、For 循环能按剪贴板的数目循环


Sub te()  '操作Office剪贴板（全部粘贴或全部清空，以及对指定粘贴项目的粘贴或删除操作）
Dim b As Byte, i As Integer
Application.ScreenUpdating = False
With CommandBars("Task Pane")
    WordBasic.editofficeclipboard
    With .Controls(1)
        b = Val(Split(.Caption, "/")(0))  '取得Office剪贴板现有粘贴项目数
        If b > 0 Then
            For i = b To 1 Step -1
                .SetFocus
                SendKeys "{LEFT 3}", False
                SendKeys "{DOWN " & i - 1 & "}", False '定位到指定的粘贴项目
                SendKeys "%{DOWN 2}", False  '在指定的粘贴项目下拉菜单选择“粘贴”项（前面数字改为3即“删除”项）
                SendKeys "{ENTER}", False  '执行粘贴（前面数字为3时执行删除）
                SendKeys "{ESC 2}", False  '焦点从任务窗格返回文档
                SendKeys "{TAB 1}", True
            Next i
                .SetFocus
                SendKeys "{LEFT 3}", False
                SendKeys "{TAB 3}", True  '焦点定位到“全部清空”
                SendKeys "{ }", False  '执行全部清空
       Else
            MsgBox "Office剪贴板是空的！"
        End If
    End With
End With
SendKeys "{ESC 2}", False  '焦点从任务窗格返回文档
Application.ScreenUpdating = True
End Sub

sylun

martingsyang 发表于 2012-7-25 23:25
感谢楼主的分享。

工作中有部分工作要从另一个系统copy内容然后paste 到word 里面，各个粘贴的项目用Tab ...

可试试如下模拟操作的代码：

1. Sub test3()
   
2.     Dim b As Byte, i As Integer
   
3.     Application.ScreenUpdating = False
   
4.     With CommandBars("Task Pane")
   
5.         WordBasic.editofficeclipboard
   
6.         With .Controls(1)
   
7.             b = Val(Split(.Caption, "/")(0))
   
8.             If b > 0 Then
   
9.                 .SetFocus
   
10.                 SendKeys "{DOWN " & b & "}"
    
11.                 For i = 1 To b
    
12.                     SendKeys "%{DOWN 2}"
    
13.                     SendKeys "{ENTER}"
    
14.                     SendKeys "{UP}", True
    
15.                     Selection.InsertBefore Chr$(9)
    
16.                     Selection.Collapse wdCollapseEnd
    
17.                 Next i
    
18.            Else
    
19.                 MsgBox "Office剪贴板是空的！"
    
20.             End If
    
21.         End With
    
22.     End With
    
23.     SendKeys "{ESC 2}"
    
24.     Application.ScreenUpdating = True
    
25. End Sub

复制代码

remote88888

上面这些是操作剪切板，我想在EXCEL中将10个数据写入的OFFICE剪切板，如何操作？只能手动吗？

LIUZHU

楼主，我依葫芦画瓢，做了一个定位到第一条，只粘贴第一条的代码，但是却无法准确定位，能指导下吗？我的Office版本是365。

1. With Application.CommandBars("Office Clipboard")
   
2.         .Visible = True
   
3.         With .Controls(1)
   
4.             .SetFocus                           '焦点移到任务窗格（剪贴板）
   
5.             SendKeys "{LEFT 3}", True           '定位到第一个粘贴项（最上面的项，即最后复制的项）
   
6.             SendKeys "%{DOWN 2}", True          '在指定的粘贴项目下拉菜单选择“粘贴”项（前面数字改为3即“删除”项）
   
7.             SendKeys "{ENTER}", True            '执行粘贴
   
8.             DoEvents
   
9.         End With
   
10.     End With

复制代码

LIUZHU

守柔 发表于 2009-1-2 17:49
谢谢sylun兄的分享！
sendkeys方法实际上的确是不得以而为之。
一般比较正规的方法，还是用API 的SendMes ...

请问，用API的解决方案有么？