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

时间:2013-05-27 15:19:38

标签: excel vba excel-vba excel-2010

在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在这里不起作用。

1 个答案:

答案 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