25.03.2016, 21:12
Hallo,
ich habe aus dem Internet folgende Funktion für die Überprüfung ob in der Zwischenablage ein Bild ist gefunden und verwende diese auch.
Es soll mittels Button nur möglich sein, ein Bild und kein Text oder sonstiges zu importieren.
Funktioniert mit Excel 32 Bit auch ohne Probleme, aber ich arbeite auch manchmal auf 64 Bit System mit der Datei und dann kommt eine FM:
"Fehler beim Kompilieren:
Der Code in diesem Projekt muss für die Verwendung auf 64-Bit-Systemen aktualisiert werden. Überarbeiten und aktualisieren Sie Declare-Anweisungen, und markieren Sie sie mit dem PtrSafe-Attribut."
Gibt es eine Möglichkeit, den Code so anzupassen, dass er auf 32 und 64 Bit läuft?
ich habe aus dem Internet folgende Funktion für die Überprüfung ob in der Zwischenablage ein Bild ist gefunden und verwende diese auch.
Es soll mittels Button nur möglich sein, ein Bild und kein Text oder sonstiges zu importieren.
Funktioniert mit Excel 32 Bit auch ohne Probleme, aber ich arbeite auch manchmal auf 64 Bit System mit der Datei und dann kommt eine FM:
"Fehler beim Kompilieren:
Der Code in diesem Projekt muss für die Verwendung auf 64-Bit-Systemen aktualisiert werden. Überarbeiten und aktualisieren Sie Declare-Anweisungen, und markieren Sie sie mit dem PtrSafe-Attribut."
Gibt es eine Möglichkeit, den Code so anzupassen, dass er auf 32 und 64 Bit läuft?
Code:
'Funktion für prüfen ob Bild in Zwischenablage
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" ( _
'ByVal wFormat As Long) As Long
Private Declare Function CountClipboardFormats Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" ( _
ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" _
Alias "GetClipboardFormatNameA" ( _
ByVal wFormat As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenA" ( _
ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" ( _
ByVal lpString1 As Any, _
ByVal lpString2 As Any) 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 Declare Function SelectObject Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal hObject As Long) As Long
' BitBlt dwRop-Konstante
Private Const SRCCOPY = &HCC0020
' Zwischenablage Format-Konstanten
Private Const CF_BITMAP = 2 ' Das Objekt in der Zwischenablage ist ein Handle eines Bitmaps
Private Const CF_DIB = 8 ' Das Objekt in der Zwischenablage ist ein Handle
' zu einer %BITMAPINFO%-Struktur
Private Const CF_DIBV5 = 17 ' (Win 2000/XP) Das Objekt in der Zwischenablage
' ist ein Handle zu einer %BITMAPV5HEADER%-Struktur
Private Const CF_DIF = 5 ' Das Objekt in der Zwischenablage ist ein
' "Software Arts' Data Interchange Format"
Private Const CF_DSPBITMAP = &H82 ' Das Objekt in der Zwischenablage ist ein
' Handle zu einem Bitmap in einem privaten Format
Private Const CF_DSPENHMETAFILE = &H8E ' Das Objekt in der Zwischenablage ist ein Handle
' zu einer Enhanced Metadatei in einem privaten Format
Private Const CF_DSPMETAFILEPICT = &H83 ' Das Objekt in der Zwischenablage ist ein Handle
' zu einer Meta Grafik in einem privaten Format
Private Const CF_DSPTEXT = &H81 ' Das Objekt in der Zwischenablage ist ein
' Handle zu einem String in einem privaten Format
Private Const CF_ENHMETAFILE = 14 ' Das Objekt in der Zwischenablage ist ein
' Handle zu einer Enhanced Metadatei
Private Const CF_GDIOBJFIRST = &H300 ' Das Objekt in der Zwischenablage ist ein GID-Object
' (wird beim Leeren der Zwischenablage nicht gelöscht)
Private Const CF_GDIOBJLAST = &H3FF ' Das Objekt in der Zwischenablage ist ein GID-Object
' (wird beim Leeren der Zwischenablage nicht gelöscht)
Private Const CF_HDROP = 15 ' Das Objekt in der Zwischenablage ist eine
' Liste von Dateihandles
Private Const CF_LOCALE = 16 ' Das Objekt in der Zwischenablage ist eine Sprach-ID,
' die für Text-Strings in der Zwischenablage benutzt wurde
Private Const CF_METAFILEPICT = 3 ' Das Objekt in der Zwischenablage ist ein
' Handle zu einem Metafile Bild
Private Const CF_OEMTEXT = 7 ' Das Objekt in der Zwischenablage ist ein
' Handle zu einem OEM-String
Private Const CF_OWNERDISPLAY = &H80 ' Das Objekt in der Zwischenablage ist
' ein benutzerdefinierter Anzeigetyp
Private Const CF_PALETTE = 9 ' Das Objekt in der Zwischenablage ist ein
' Handle zu einer Palette
Private Const CF_PENDATA = 10 ' Das Objekt der Zwischenablage sind daten zu
' einem Microsoft Pen Extensions
Private Const CF_PRIVATEFIRST = &H200 ' Das Objekt in der Zwischenablage ist
' ein privates Handle
Private Const CF_PRIVATELAST = &H2FF ' Das Objekt in der Zwischenablage ist
' ein privates Handle
Private Const CF_RIFF = 11 ' Das Objekt in der Zwischenablage ist ein Handle
' zu einer Audiodatei
Private Const CF_SYLK = 4 ' Das Objekt in der Zwischenablage ist ein
' symbolischer Link
Private Const CF_TEXT = 1 ' Das Objekt in der Zwischenablage ist ein Handle
' zu einem String
Private Const CF_WAVE = 12 ' Das Objekt in der Zwischenablage ist ein Handle
' zu einer Wavedatei
Private Const CF_TIFF = 6 ' Das Objekt in der Zwischenablage ist ein Handle
' zu einem Tiff-Bitmap
Private Const CF_UNICODETEXT = 13 ' Das Objekt in der Zwischenablage ist ein
' Handle zu einem Unicode-String
Public Function IsClibboardText() As Boolean
Dim bolResult As Boolean
bolResult = False
Dim hTmpStr As Long
Dim pTmpStr As Long
Dim TmpStr As String
' Zwischenablage öffnen
Call OpenClipboard(0)
' Anzahl der verschiedenen Formate der Zwischenablage ermitteln
'Debug.Print "Anzahl verschiedender Clipboard-Formate: " & CountClipboardFormats()
' Prüfen, welche Datenformate sich in der
' Zwischenablage befinden
For i = 0 To CountClipboardFormats - 1
lngformat = EnumClipboardFormats(lngformat)
If lngformat = 0 Then Exit For
' Format auswerten
Select Case lngformat
Case CF_TEXT
' Handle zum String ermitteln
hTmpStr = GetClipboardData(CF_TEXT)
' Pointer des Strings ermitteln
pTmpStr = GlobalLock(hTmpStr)
' String in eine Variable kopieren
TmpStr = Space(lstrlen(ByVal pTmpStr))
Call lstrcpy(TmpStr, ByVal pTmpStr)
'Debug.Print " text aus der Zwischenablage: " & TmpStr
' Pointer zerstören um Ressourcen zu sparen
GlobalUnlock hTmpStr
Call CloseClipboard
bolResult = True
IsClibboardText = bolResult
Exit Function
Case Else
End Select
Next i
IsClibboardText = bolResult
Call CloseClipboard
End Function
LG Herbert
Windows 10
Office 365
Windows 10
Office 365
Man könnte jedoch überlegen, ob man den Code so schreiben kann, dass er in beiden Versionen läuft.