|
因为复制的内容在剪贴板中转换为文本后最后有个换行符,粘贴完了以后再按一下退格键把换行符清除掉就可以了
或者用下面的代码替代附件中的宏
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Const GMEM_MOVEABLE = &H2
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Const CF_TEXT = 1
Private Const CF_UNICODETEXT = 13
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim hMem As Long
Dim lpMem As Long
Dim strText As String
If Target.Column <> 1 Then Exit Sub
If Len(Target.Value) = 0 Then Exit Sub
Cancel = True
strText = Target.Value
nSize = LenB(strText)
hMem = GlobalAlloc(GMEM_MOVEABLE, nSize)
lpMem = GlobalLock(hMem)
CopyMemory ByVal lpMem, ByVal StrPtr(strText), nSize
GlobalUnlock hMem
OpenClipboard Application.hwnd
EmptyClipboard
SetClipboardData CF_UNICODETEXT, hMem
CloseClipboard
End Sub
|
|