Vba 将单元格值复制到剪贴板
我已经尝试使用下面的代码将单元格值复制到剪贴板,并仅使用快捷方式Vba 将单元格值复制到剪贴板,vba,excel,Vba,Excel,我已经尝试使用下面的代码将单元格值复制到剪贴板,并仅使用快捷方式Ctrl+V(不是硬编码,只是手动)将其粘贴,但它只粘贴字符??。有人知道怎么处理吗 temp.Range("BM1").Value = ws.txtFileName With New DataObject .SetText temp.Range("BM1").Text .PutInClipboard End With txtFileName是一个activeX文本框。或者任何人都知道如何将文本框值直接复制到剪贴
Ctrl+V
(不是硬编码,只是手动)将其粘贴,但它只粘贴字符??
。有人知道怎么处理吗
temp.Range("BM1").Value = ws.txtFileName
With New DataObject
.SetText temp.Range("BM1").Text
.PutInClipboard
End With
txtFileName
是一个activeX文本框。或者任何人都知道如何将文本框值直接复制到剪贴板?API版本:
Option Explicit
#If Mac Then
' ignore
#Else
#If VBA7 Then
Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As LongPtr) As LongPtr
Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As LongPtr
Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As LongPtr) As LongPtr
#Else
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long
#End If
#End If
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String)
#If Mac Then
With New MSForms.DataObject
.SetText MyString
.PutInClipboard
End With
#Else
#If VBA7 Then
Dim hGlobalMemory As LongPtr
Dim hClipMemory As LongPtr
Dim lpGlobalMemory As LongPtr
#Else
Dim hGlobalMemory As Long
Dim hClipMemory As Long
Dim lpGlobalMemory As Long
#End If
Dim x As Long
' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)
' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
' Clear the Clipboard.
x = EmptyClipboard()
' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
#End If
End Function
API版本:
Option Explicit
#If Mac Then
' ignore
#Else
#If VBA7 Then
Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As LongPtr) As LongPtr
Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As LongPtr
Declare PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As LongPtr) As LongPtr
#Else
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long
#End If
#End If
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String)
#If Mac Then
With New MSForms.DataObject
.SetText MyString
.PutInClipboard
End With
#Else
#If VBA7 Then
Dim hGlobalMemory As LongPtr
Dim hClipMemory As LongPtr
Dim lpGlobalMemory As LongPtr
#Else
Dim hGlobalMemory As Long
Dim hClipMemory As Long
Dim lpGlobalMemory As Long
#End If
Dim x As Long
' Allocate moveable global memory.
'-------------------------------------------
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
' Lock the block to get a far pointer
' to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)
' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
GoTo OutOfHere2
End If
' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
' Clear the Clipboard.
x = EmptyClipboard()
' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
#End If
End Function
如果您使用的是Win8或更高版本,并且打开了Windows资源管理器,则会出现一个与您描述的相同的错误。使用API调用更安全。@Rory API是什么意思?请检查此处-如果您使用的是Win8或更高版本,并且您打开了Windows资源管理器,则会出现一个与您描述的相同的错误。使用API调用更安全。@Rory API是什么意思?检查这里-这与这里相同吗:?@ramedju大致上是的,除了我的版本正确地适应了64位之外,与那个版本不同。;)这和这里的一样吗:?@ramedju大致上是的,除了我的版本正确地适应了64位之外,与那个版本不同