2017-08-22 111 views
1

我試過使用下面的代碼將單元格值複製到剪貼板並粘貼它只是使用快捷方式Ctrl+V(不是硬編碼,只是手動),但它只是粘貼字符??。任何人都知道如何處理它?複製單元格值到剪貼板

temp.Range("BM1").Value = ws.txtFileName 

With New DataObject 
    .SetText temp.Range("BM1").Text 
    .PutInClipboard 
End With 

txtFileName是一個activeX文本框。或者任何人都知道如何將文本框的值直接複製到剪貼板?

+0

如果你正在使用的Win8或更高版本,你有Windows資源管理器打開,有一個bug,做你的描述。使用API​​調用更安全。 – Rory

+0

@Rory你是什麼意思的API? – ramedju

+1

在這裏檢查 - https://stackoverflow.com/questions/37843131/excel-vba-dataobjectputinclipboard-not-實施 – Vityata

回答

1

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 

然後調用代碼變爲:

temp.Range("BM1").Value = ws.txtFileName 

    Clipboard_setdata temp.Range("BM1").Text 
+0

這與這裏是一樣的:https://www.thespreadsheetguru.com/blog/2015/1/ 13/how-to-use-vba-code-copy-text-to-the-clipboard? – ramedju

+0

@ramedju大致上,是的,除了我的版本正確適用於64位,不像那個。 ;) – Rory