使用VBA将文本复制到剪贴板

在MS Excel 2010中，我试图使用SendKeys将一些文本复制到剪贴板。 但是，它不起作用。

这是微软为防止人们制造欺诈性macros而采取的某种安全措施吗？ 下面是一些代码，显示了我正在尝试做的事情（假设你在vba窗口并select了一些文本）：

 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对象库）。

---

编辑：我试图复制的文本不在文档窗口中，而是在vba项目窗口的直接窗口中！ 所以Selection.Copy不会在这里工作。

Answer 1

下面的代码使用Windows API中的SendInput函数来模拟Control – C组合键，以便将当前文本select复制到剪贴板。

复制/打印子程序（代码中的最后一个程序）调用两个实用程序函数来触发必要的按键，然后使用准备好的代码从剪贴板中检索文本。

我在“立即”窗口，代码编辑器窗格和工作表中testing了代码。

  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