Question

我制作了Excel / VBA程序，通过回答这个问题监视剪贴板：Excel VBA paste from external program

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总是会崩溃。

This website说我们无法在单元格处于编辑模式时运行宏，所以我猜Excel崩溃了，因为窗口过程尝试运行VBA宏，尽管它不起作用。

我该如何避免这个问题？

监视剪贴板时发生错误

0 个答案: