在MS Excel 2010中,我尝试使用SendKeys
将一些文本复制到剪贴板。但是,它不起作用。
这是微软为防止人们制造欺诈性宏而采取的某种安全措施吗?这里有一些代码显示了我正在尝试做的事情(假设您在vba窗口中并选择了一些文本):
Public Sub CopyToClipboardAndPrint()
Call SendKeys("^(C)", True)
Dim Clip As MSForms.DataObject
Set Clip = New MSForms.DataObject
Clip.GetFromClipboard
Debug.Print Clip.GetText
End Sub
请注意,为了使用MSForms.DataObject,您必须引用%windir%\system32\FM20.DLL
(即Microsoft Forms 2.0对象库)。
<小时/> 修改 我试图复制的文本是文档窗口中的 not ,但是在vba项目窗口的即时窗口中!所以Selection.Copy在这里不起作用。
答案 0 :(得分:3)
以下代码使用Windows API中的SendInput函数来模拟 Control - C 组合键,以便将当前文本选择复制到剪贴板。
复制/打印子例程(代码中的最后一个过程)调用两个实用程序函数来触发必要的按键操作,然后使用您准备的代码从剪贴板中检索文本。
我已经在立即窗口,代码编辑器窗格和工作表中测试了代码。
Option Explicit
'adapted from:
' http://www.mrexcel.com/forum/excel-questions/411552-sendinput-visual-basic-applications.html
Const VK_CONTROL = 17 'keycode for Control key
Const VK_C = 67 'keycode for "C"
Const KEYEVENTF_KEYUP = &H2
Const INPUT_KEYBOARD = 1
Private Type KEYBDINPUT
wVK As Integer
wScan As Integer
dwFlags As Long
time As Long
dwExtraInfo As Long
End Type
Private Type GENERALINPUT
dwType As Long
xi(0 To 23) As Byte
End Type
Private Declare Function SendInput Lib "user32.dll" _
(ByVal nInputs As Long, _
pInputs As GENERALINPUT, _
ByVal cbSize As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDst As Any, _
pSrc As Any, _
ByVal ByteLen As Long)
Private Sub KeyDown(bKey As Byte)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVK = bKey
KInput.dwFlags = 0
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
Call SendInput(1, GInput(0), Len(GInput(0)))
End Sub
Private Sub KeyUp(bKey As Byte)
Dim GInput(0 To 1) As GENERALINPUT
Dim KInput As KEYBDINPUT
KInput.wVK = bKey
KInput.dwFlags = KEYEVENTF_KEYUP
GInput(0).dwType = INPUT_KEYBOARD
CopyMemory GInput(0).xi(0), KInput, Len(KInput)
Call SendInput(1, GInput(0), Len(GInput(0)))
End Sub
Sub CopyToClipboardAndPrint()
Dim str As String
'Simulate control-C to copy selection to clipboard
KeyDown VK_CONTROL
KeyDown VK_C
KeyUp VK_C
KeyUp VK_CONTROL
DoEvents
Dim Clip As MSForms.DataObject
Set Clip = New MSForms.DataObject
Clip.GetFromClipboard
Debug.Print Clip.GetText
End Sub