Excel und Clipboard API

Code / Programme die SAP Themen behandeln z.B Excel Makros

Excel und Clipboard API

Postby Tron » Wed Feb 03, 2021 10:35 am

Clipboard via WIN32 API
Code: [Select all] [Expand/Collapse] [Download] (Untitled.txt)
  1. Option Explicit
  2.  
  3. Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  4. Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long)  As Long
  5. Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long,  ByVal dwBytes As Long) As Long
  6. Declare Function CloseClipboard Lib "User32" () As Long
  7. Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
  8. Declare Function EmptyClipboard Lib "User32" () As Long
  9. Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
  10. Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
  11.  
  12. Public Const GHND = &H42
  13. Public Const CF_TEXT = 1
  14. Public Const MAXSIZE = 4096
  15.  
  16. Function ClipBoard_SetData(MyString As String)
  17.    Dim hGlobalMemory As Long, lpGlobalMemory As Long
  18.    Dim hClipMemory As Long, X As Long
  19.  
  20.    ' Allocate moveable global memory.
  21.   '-------------------------------------------
  22.   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)
  23.  
  24.    ' Lock the block to get a far pointer
  25.   ' to this memory.
  26.   lpGlobalMemory = GlobalLock(hGlobalMemory)
  27.  
  28.    ' Copy the string to this global memory.
  29.   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
  30.    ' Copy the string to this global memory.
  31.   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)
  32.       ' Unlock the memory.
  33.   If GlobalUnlock(hGlobalMemory) <> 0 Then
  34.       MsgBox "Could not unlock memory location. Copy aborted."
  35.       GoTo OutOfHere2
  36.    End If
  37.  
  38.    ' Open the Clipboard to copy data to.
  39.   If OpenClipboard(0&) = 0 Then
  40.       MsgBox "Could not open the Clipboard. Copy aborted."
  41.       Exit Function
  42.    End If
  43.  
  44.    ' Clear the Clipboard.
  45.   X = EmptyClipboard()
  46.  
  47.    ' Copy the data to the Clipboard.
  48.   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
  49.  
  50. OutOfHere2:
  51.  
  52.    If CloseClipboard() = 0 Then
  53.       MsgBox "Could not close Clipboard."
  54.    End If
  55.  
  56. End Function
GeSHi ©


Source: https://docs.microsoft.com/en-us/office ... -clipboard
Code: [Select all] [Expand/Collapse] [Download] (Untitled.txt)
  1. Option Explicit
  2. Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
  3. Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
  4. Private Declare Function CloseClipboard Lib "user32.dll" () As Long
  5. Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
  6. Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
  7. Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
  8. Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  9. Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  10. Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  11. Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
  12. Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
  13.  
  14. Public Sub SetClipboard(sUniText As String)
  15.     Dim iStrPtr As Long
  16.     Dim iLen As Long
  17.     Dim iLock As Long
  18.     Const GMEM_MOVEABLE As Long = &H2
  19.     Const GMEM_ZEROINIT As Long = &H40
  20.     Const CF_UNICODETEXT As Long = &HD
  21.     OpenClipboard 0&
  22.     EmptyClipboard
  23.     iLen = LenB(sUniText) + 2&
  24.     iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
  25.     iLock = GlobalLock(iStrPtr)
  26.     lstrcpy iLock, StrPtr(sUniText)
  27.     GlobalUnlock iStrPtr
  28.     SetClipboardData CF_UNICODETEXT, iStrPtr
  29.     CloseClipboard
  30. End Sub
  31.  
  32. Public Function GetClipboard() As String
  33.     Dim iStrPtr As Long
  34.     Dim iLen As Long
  35.     Dim iLock As Long
  36.     Dim sUniText As String
  37.     Const CF_UNICODETEXT As Long = 13&
  38.     OpenClipboard 0&
  39.     If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
  40.         iStrPtr = GetClipboardData(CF_UNICODETEXT)
  41.         If iStrPtr Then
  42.             iLock = GlobalLock(iStrPtr)
  43.             iLen = GlobalSize(iStrPtr)
  44.             sUniText = String$(iLen \ 2& - 1&, vbNullChar)
  45.             lstrcpy StrPtr(sUniText), iLock
  46.             GlobalUnlock iStrPtr
  47.         End If
  48.         GetClipboard = sUniText
  49.     End If
  50.     CloseClipboard
  51. End Function
GeSHi ©
Tron
.....
.....
 
Posts: 1112
Joined: Sat Aug 04, 2007 10:21 pm

Return to Externe SAP Utilities und Goodies

Who is online

Users browsing this forum: No registered users and 1 guest

cron