Question

我需要从外部程序粘贴到Excel中，然后移动到下一行。到目前为止，我有这个代码，当我手动运行它时。

#!/usr/bin/perl
use strict;
use warnings;
my $expected = qr{ABC+DEF};
my $actual_state = qr{ABC+DEF};
#my $actual_state = qr{ABC+DEF,};
#my $actual_state = qr{ABC+DEF,,};
#if $actual_state has comma then you can do search and replace
$actual_state =~ s/,//g;
print "Matched" if $expected =~ /\Q$actual_state\E/;
#prints "Matched"

我的问题是如何让Excel监听新的剪贴板数据，只在新数据到达剪贴板时粘贴？

Answer 1

尝试使用以下代码。它会将最新的剪贴板数据复制到excel

Sub test()
    Dim getallformat
    getallformat = Application.ClipboardFormats
    For Each crnt In getallformat
        If crnt = xlClipboardFormatText Then
            Range("A1").PasteSpecial (xlPasteAll)
        End If
    Next
End Sub

Answer 2

这是监控剪贴板的原始但有效的方法。

测试剪贴板是否有数据
粘贴新数据
清除ClipBoard
等待1秒
重新开始

Private Declare Function OpenClipboard Lib "User32.dll" (ByVal hWndNewOwner As Long) As Long
Private Declare Function EmptyClipboard Lib "User32.dll" () As Long
Private Declare Function CloseClipboard Lib "User32.dll" () As Long
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Private Declare Function hasClipBoardData Lib "user32" Alias "CountClipboardFormats" () As Boolean

Public Sub ClearClipboard()
    Dim Ret

    Ret = OpenClipboard(0&)
    If Ret <> 0 Then Ret = EmptyClipboard
    CloseClipboard
End Sub

Sub Paste_From_External()
    Dim cell As Range

    Do While True

        If hasClipBoardData Then
            ActiveSheet.PasteSpecial Format:="Unicode Text", Link:=False, DisplayAsIcon:=False
            ActiveCell.Offset(1).Select
            ClearClipboard
        End If

        Application.Wait Now + TimeValue("0:00:01")   'Wait for 1 second

        DoEvents

    Loop

End Sub

Refernce：Get text from clipboard using GetText - avoid error on empty clipboard

您还可以使用API调用挂钩ClipBoard事件。这是VB.Net中的一个例子：Monitoring clipboard for changes。我能够获得回调但无法将数据粘贴。

Answer 3

剪贴板查看器

我修改了这个VB6示例Clipboard Viewer/Monitor OCX以有效监控ClipBoard。

StartViewer True

挂钩Excel应用程序窗口
WndProc现在将收到任何应用程序窗口消息
SetClipboardViewer将应用程序窗口放入剪贴板查看器链中。一旦进入链中，应用程序窗口将收到ClipBoard更改消息。

Option Explicit
' http://www.freevbcode.com/ShowCode.asp?ID=1306

Public mNextClip As Long, mPrevHandle As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function SetClipboardViewer Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ChangeClipboardChain Lib "user32" (ByVal hwnd As Long, ByVal hWndNext As Long) As Long
Public Const WM_CHANGECBCHAIN = &H30D
Public Const WM_DRAWCLIPBOARD = &H308
Public Const GWL_WNDPROC = (-4)
Public Const GWL_HINSTANCE = (-6)
Public Const GWL_HWNDPARENT = (-8)
Public Const GWL_ID = (-12)
Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_USERDATA = (-21)
Public Const WM_LBUTTONDBLCLK = &H203

Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    Select Case Msg
        Case WM_DRAWCLIPBOARD
            'The clipboard is changed.
            'A trick here, send a double click message to _
             the usercontrol and then raise ClipboardChanged event
            SendMessage hwnd, WM_LBUTTONDBLCLK, 0, 0
            SendMessage mNextClip, Msg, wParam, lParam

            PrintClipBoard
        Case WM_CHANGECBCHAIN
            'Another clipboard viewer closed
            If mNextClip = wParam Then
                mNextClip = lParam
            Else
                SendMessage mNextClip, Msg, wParam, lParam
            End If
    End Select

    WndProc = CallWindowProc(mPrevHandle, hwnd, Msg, wParam, lParam)

End Function

Public Sub SubClass(mHandle As Long, mAddress As Long)

    mPrevHandle = GetWindowLong(mHandle, GWL_WNDPROC)
    SetWindowLong mHandle, GWL_WNDPROC, mAddress
    mNextClip = SetClipboardViewer(mHandle)
End Sub

Public Sub UnSubClass(mHandle As Long)

    SetWindowLong mHandle, GWL_WNDPROC, mPrevHandle
    ChangeClipboardChain mHandle, mNextClip
End Sub

Sub StartViewer(StartViewer As Boolean)
    If StartViewer Then
        SubClass Application.hwnd, AddressOf WndProc
    Else
        UnSubClass Application.hwnd
    End If

End Sub

Sub PrintClipBoard()
    Dim temp As String
    Dim clip As DataObject
    Set clip = New DataObject
    clip.GetFromClipboard

    On Error Resume Next
    temp = clip.GetText
    Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).Value = temp
    On Error GoTo 0

End Sub

资源：

从外部程序粘贴Excel VBA

3 个答案:

剪贴板查看器