iInfo 資訊交流: Excel VBA清除剪貼簿內容

最新消息

[公告2014/05/30] 如有需要將部落格中,任何一篇文章的程式碼使用在商業用途,請與我聯繫。

[公告2015/04/26] Line版的 iInfo程式與投資應用 群組已上線想加入的朋友們,請先查看 "入群須知" 再與我聯繫 Line : aminwhite5168,加入請告知身分與回答 "入群須知" 的問題。

[公告2017/02/20] 近來有網友詢問 MultiCharts 與 Excel 畫冰火能量圖 (8)MultiCharts 與Excel 畫冰火能量圖(11) --- 更名「台股儀表板」 文章中教學檔案取得方式,有興趣的朋友可透過 Line了解詳情 (請勿以為是免費分享),Line : aminwhite5168。

[公告2018/04/22] 台北 Python + Excel VBA 金融資訊爬蟲課程,於 7/21、7/22 兩天開課,課程如網頁內容 金融資訊爬蟲班:台北班 Python 金融資訊爬蟲、EXCEL VBA 金融資訊爬蟲,5/30 前早鳥優惠票,請盡快把握機會,歡迎券商、大專院校邀約講座。。

2016年10月30日 星期日

Excel VBA清除剪貼簿內容

近期為了解決一個在Excel上進行大量複製時而發生記憶體空間不足的問題,想說要將清除剪貼簿內容,但始終不得其門而入,後來將程式改寫另一種優化方法克服。
這裡將先將找到清除剪貼簿內容先做一紀錄,等未來找到更好解法再行補充。
透過VBA清除剪貼簿的程式碼
程式碼1
Const DATAOBJECT_BINDING As String = "new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"
Sub 清除剪貼簿內容()
    With CreateObject(DATAOBJECT_BINDING)
        .Clear
    End With
End Sub
程式碼2
#If VBA7 Then
    Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
    Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
    Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
#Else
    Declare Function CloseClipboard Lib "User32" () As Long
    Declare Function EmptyClipboard Lib "User32" () As Long
    Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
#End If

Sub EmptyCB()
    OpenClipboard (GetClipboardOwner)
    EmptyClipboard
    CloseClipboard
End Sub

這裡請注意,上面的程式碼並無法有效將 Excel 剪貼簿內容清除,只能將複製時的暫存內容做清除,要把系統剪貼簿的內容作清除,恐怕還要再找實驗研究了

取得剪貼簿資資料內容
#If VBA7 Then
    Declare PtrSafe Function GetClipboardOwner Lib "User32" () As Long
    Declare PtrSafe Function CloseClipboard Lib "User32" () As Long
    Declare PtrSafe Function EmptyClipboard Lib "User32" () As Long
    Declare PtrSafe Function OpenClipboard Lib "User32" (ByVal hwnd As LongPtr) As Long
    
    Declare PtrSafe Function GetClipboardData Lib "User32" (ByVal wFormat As LongPtr) As Long
    Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As LongPtr) As Long
    Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
#Else
    Declare Function GetClipboardOwner Lib "User32" () As Long
    Declare Function CloseClipboard Lib "User32" () As Long
    Declare Function EmptyClipboard Lib "User32" () As Long
    Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
    Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
    Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
    Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
    Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
#End If
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
 
Public Const GHND = &H42
Public Const CF_TEXT = 2
Public Const MAXSIZE = 4096
 
Function 取得剪貼簿內容()
   Dim hClipMemory As Long
   Dim lpClipMemory As Long
   Dim MyString As String
   Dim RetVal As Long
 
   If OpenClipboard(GetClipboardOwner) = 0 Then
      MsgBox "無法開啟剪貼簿"
      Exit Function
   End If
          
   ' Obtain the handle to the global memory
   ' block that is referencing the text.
   hClipMemory = GetClipboardData(CF_TEXT)
   If IsNull(hClipMemory) Then
      MsgBox "無法配置記憶體空間"
      GoTo OutOfHere
   End If
 
   ' Lock Clipboard memory so we can reference
   ' the actual data string.
   lpClipMemory = GlobalLock(hClipMemory)
   If Not IsNull(lpClipMemory) Then
      MyString = Space$(MAXSIZE)
      RetVal = lstrcpy(MyString, lpClipMemory)
      RetVal = GlobalUnlock(hClipMemory)
       
      ' Peel off the null terminating character.
      MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
   Else
      MsgBox "無法取得字串內容"
   End If
 
OutOfHere:
   RetVal = CloseClipboard()
   ClipBoard_GetData = MyString 
End Function