vba发送按键和设置剪贴板的问题出错，求助大侠哦

hanzinu

想要的功能是选择 一个单元格范围如 B5：C9 ，点击发送后，所选范围的数据存入二维数组，
发送一个按键，再下面是一个循环，循环的内容是：
        设置剪贴板值为aa，发送按键ctrl+f，发送按键ctrl+v，发送按键enter
        设置剪贴板值为1，发送按键ctrl+v，发送按键enter
        设置剪贴板值为bb，发送按键ctrf+f，发送按键ctrl+v，发送按键enter
        设置剪贴板值为2，发送按键ctrl+v，发送按键enter
        设置剪贴板值为cc，发送按键ctrl+f，发送按键ctrl+v，发送按键enter
        设置剪贴板值为3，发送按键ctrl+v，发送按键enter
        ……
在运行时经常提示错误，而且发送按键有些也不准确，不知道是哪里的错误呢
运行时错误‘-2147221040（800401d0）’：
dataobject:PutInClipboard OpenClipboard失败
------------------------------------------------------------------------------------------------
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub send_msg()
Dim arr() As Variant, x, y As Integer, ww_name, post_num As String, my_clip As New DataObject

arr = Application.Selection                         '选择区域赋值给数组

Application.SendKeys "^%w"
Sleep 400

For x = 1 To UBound(arr, 1)

            my_clip.SetText arr(x, 1)
            my_clip.PutInClipboard

            Sleep 200

            Application.SendKeys "^f", True
            Sleep 100

            Application.SendKeys "^v", True
            Sleep 300

            Application.SendKeys "~"
            Sleep 300

            my_clip.SetText arr(x, 2)
            my_clip.PutInClipboard
            Sleep 300

            Application.SendKeys "^v"

            Application.SendKeys "~"

            Sleep 200

Next x
End Sub
------------------------------------------------------------------------------------------------------------------
发送键 剪贴板.rar (14.66 KB, 下载次数: 5)

2013-12-27 21:31 上传

点击文件名下载附件

hanzinu

在运行时经常提示错误，而且发送按键有些也不准确，不知道是哪里的错误呢
运行时错误‘-2147221040（800401d0）’：
dataobject:PutInClipboard OpenClipboard失败

有时候行 有时候又提示出错不知道啥回事呢

jsxjd

发送 ctrl + f 想弹出查找对话框吗？

zhshspark

我也碰到了同样的问题，我是把Excel里的内容copy and paste到浏览器里面，我大约隔几个月就会用到一次这样的操作，有的时候很顺畅，有的时候就发生了错乱。尝试了各种解决之道，但是没有解决。

zhshspark

Dim text As String
Dim oData As DataObject
Dim IntLine As Integer

Set oData = New DataObject
oData.SetText ""
oData.PutInClipboard
ActiveCell.Activate


text = ActiveCell.Value
oData.SetText text
oData.PutInClipboard
SendKeys "^a", True
SendKeys "{DEL}", True
SendKeys "^v", True
SendKeys "{TAB}", True
SendKeys "{TAB}", True

ActiveCell.Offset(1, 0).Activate
text = ActiveCell.Value
oData.SetText text
oData.PutInClipboard
SendKeys "^a", True
SendKeys "{DEL}", True
SendKeys "^v", True
SendKeys "{TAB}", True

ActiveCell.Offset(0, 1).Activate
text = ActiveCell.Value
oData.SetText text
oData.PutInClipboard
SendKeys "^a", True
SendKeys "{DEL}", True
SendKeys "^v", True
'SendKeys "{ENTER}", True
SendKeys "{TAB}", True

ActiveCell.Offset(0, 1).Activate
text = ActiveCell.Value
oData.SetText text
oData.PutInClipboard
SendKeys "^a", True
SendKeys "{DEL}", True
SendKeys "^v", True
'SendKeys "{ENTER}", True
SendKeys "{TAB}", True

oData.Clear
Set oData = Nothing

End Sub

zhshspark

哥们，我用如下链接的方法解决了这个问题
https://stackoverflow.com/questions/14738330/office-2013-excel-putinclipboard-is-different