Reputation: 97
I need to paste into Excel from an external program them move onto the next line. I have this code so far that works when I manually run it.
Sub Paste_From_External()
ActiveCell.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1).Select
End Sub
My question is how can I have Excel listen for new clipboard data and only paste when new data hits the clipboard?
Upvotes: 0
Views: 3517
Reputation:
I modified this VB6 example Clipboard Viewer/Monitor OCX to efficiently monitor the ClipBoard.
StartViewer True
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
Resources:
Upvotes: -1
Reputation:
Here is rather a crude but effective way of monitoring the clipboard.
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
You could also hook the ClipBoard event using API calls. Here is an example in VB.Net: Monitoring clipboard for changes. I was able to get the callback but could not get the data to paste.
Upvotes: 1
Reputation: 2713
Try with below code. It will copy the latest clipboard data into 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
Upvotes: 2