Das Clever-Excel-Forum.de - Treffen
... 14.-16. September 2018 im Allgäu ...

Code anpassen 32/64 Bit
#1
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?

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 7
Excel 2010
to top
#2
Hallo!

https://msdn.microsoft.com/de-de/library...e.14).aspx

Gruß, René
to top
#3
Hallo Rene,

danke für den Hinweis.
Ich kenne mich mit VBA nicht gut aus, habe jetzt im ersten Teil des Codes vor jedem "Function" "PtrSafe"  geschrieben.
Dann war der Code auch nicht mehr rot und das Makro funktioniert jetzt auf 64 Bit.
Reicht das oder muss ich noch was machen?
Code:
'Funktion für prüfen ob Bild in Zwischenablage
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EnumClipboardFormats Lib "user32" ( _
 ByVal wFormat As Long) As Long
Private Declare PtrSafe Function CountClipboardFormats Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" ( _
 ByVal wFormat As Long) As Long
Private Declare PtrSafe Function GetClipboardFormatName Lib "user32" _
 Alias "GetClipboardFormatNameA" ( _
 ByVal wFormat As Long, _
 ByVal lpString As String, _
  ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" _
 Alias "lstrlenA" ( _
 ByVal lpString As Any) As Long
Private Declare PtrSafe Function lstrcpy Lib "kernel32" _
 Alias "lstrcpyA" ( _
 ByVal lpString1 As Any, _
 ByVal lpString2 As Any) As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" ( _
 ByVal hMem As Long) As Long
Private Declare PtrSafe 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 7
Excel 2010
to top
#4
Hallo Herbert,

wenn's funktionier, dürfte es reichen :-) Man könnte jedoch überlegen, ob man den Code so schreiben kann, dass er in beiden Versionen läuft.
Hier mal der Vollständigkeit halber noch eine Seite:
http://www.jkp-ads.com/articles/apideclarations.asp
   \\\|///      Hoffe, geholfen zu haben.
   ( ô ô )      Grüße, André aus G in T  
 ooO-(_)-Ooo    (Excel 97-2016)
to top
#5
Hallo,

Zitat:Man könnte jedoch überlegen, ob man den Code so schreiben kann, dass er in beiden Versionen läuft.

ich habe den Code auch unter 32 bit probiert, läuft auch dort vorerst ohne Fehler.

Für weitere Anpassungen fehlen mit die VBA Kenntnisse.

Ich werd es vorerst so belassen.

Danke für die Hinweise.
LG Herbert
Windows 7
Excel 2010
to top
#6
Moin Herbert!

Zitat:ich habe den Code auch unter 32 bit probiert, läuft auch dort vorerst ohne Fehler.

Ja, Du hast ja auch xl2010 32-Bit, also VBA7, also keine Probleme.
Soll der Code aber auch auf xl2007 oder älter funktionieren, musst Du differenzieren.
Siehe auch MS:
https://msdn.microsoft.com/de-de/library...78832.aspx

Gruß Ralf
to top
#7
Hallo Ralf,

danke für diesen Hinweis.
Ich arbeite ich mit dieser Datei nur in Vers. ab 2010, somit dürfte das kein Problem sein.

Danke!
LG Herbert
Windows 7
Excel 2010
to top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste