Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Fehler wegen 64 Bit bei Makro

Fehler wegen 64 Bit bei Makro
09.01.2019 12:53:53
Michael
Hallo Zusammen,
ich verwendete ein Excelmakro, wo ich die makierten Zellen, als Bild abspeichern konnt.
Nun habe ich das System gewechselt, und jetzt bringt er mir eine Fehlermeldung bezüglich der 64 Bit. Das Makro ist im oberen Teil auch rot makiert.
Habe dann mal andere Makros gesucht, aber hier wird mir leider immer nur ein weißes Feld gespeichert als JPG. Also leider auch nicht hilfreich.
Gruß Michael
Option Explicit
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" ( _
ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32.dll" ( _
ByVal hWnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" ( _
ByVal wFormat As Integer) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" ( _
ByRef PicDesc As uPicDesc, _
ByRef RefIID As GUID, _
ByVal fPictureOwnsHandle As Long, _
ByRef IPic As IPicture) As Long
Declare Function CopyEnhMetaFile Lib "gdi32.dll" Alias "CopyEnhMetaFileA" ( _
ByVal hemfSrc As Long, _
ByVal lpszFile As String) As Long
Declare Function CopyImage Lib "user32.dll" ( _
ByVal handle As Long, _
ByVal un1 As Long, _
ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal un2 As Long) As Long
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
------------------------------------------------------
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type uPicDesc
lngSize As Long
lngType As Long
lnghPic As Long
lnghPal As Long
End Type
Private Const E_ABORT = &H80004004
Private Const E_ACCESSDENIED = &H80070005
Private Const E_FAIL = &H80004005
Private Const E_HANDLE = &H80070006
Private Const E_INVALIDARG = &H80070057
Private Const E_NOINTERFACE = &H80004002
Private Const E_NOTIMPL = &H80004001
Private Const E_OUTOFMEMORY = &H8007000E
Private Const E_POINTER = &H80004003
Private Const E_UNEXPECTED = &H8000FFFF
Private Const S_OK = &H0
Private Const CF_BITMAP = 2
Private Const CF_PALETTE = 9
Private Const CF_ENHMETAFILE = 14
Private Const IMAGE_BITMAP = 0
Private Const LR_COPYRETURNORG = &H4
Private Const FOLDER_NAME = "H:\"
Private Const FILE_NAME = "Angebot.jpg"
Public Sub Angebot_speichern()
Dim vntPicture As Variant
Dim lngReturn As Long
Selection.CopyPicture xlScreen, xlBitmap
Set vntPicture = Paste_Picture(xlBitmap)
If Not vntPicture Is Nothing Then
lngReturn = MakeSureDirectoryPathExists(FOLDER_NAME)
If lngReturn = 0 Then
MsgBox "Unalble to create folder: '" & FOLDER_NAME & "'.", vbCritical, "Error"
Else
stdole.StdFunctions.SavePicture vntPicture, FOLDER_NAME & FILE_NAME
End If
Else
MsgBox "Not possible to save picture.", vbCritical, "Error"
End If
End Sub
Function Paste_Picture(Optional lXlPicType As Long = xlPicture) As IPicture
Dim lngReturn As Long, hPtr As Long, hPal As Long
Dim lngPicType As Long, hCopy As Long
lngPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)
If IsClipboardFormatAvailable(lngPicType) 0 Then
lngReturn = OpenClipboard(Application.hWnd)
If lngReturn > 0 Then
hPtr = GetClipboardData(lngPicType)
If lngPicType = CF_BITMAP Then
hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
Else
hCopy = CopyEnhMetaFile(hPtr, vbNullString)
End If
Call CloseClipboard
If hPtr 0 Then Set Paste_Picture = Create_Picture(hCopy, 0, lngPicType)
End If
End If
End Function
Private Function Create_Picture( _
ByVal lnghPic As Long, _
ByVal lnghPal As Long, _
ByVal lngPicType As Long) As IPicture
Const PICTYPE_BITMAP = 1
Const PICTYPE_ENHMETAFILE = 4
Dim lngReturn As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPicture
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
With uPicInfo
.lngSize = Len(uPicInfo)
.lngType = PICTYPE_BITMAP
.lnghPic = lnghPic
.lnghPal = lnghPal
End With
lngReturn = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)
If lngReturn  0 Then MsgBox "Error occure" & OLEError(lngReturn), vbCritical, "Error"
Set Create_Picture = IPic
End Function

Private Function OLEError(lErrNum As Long) As String
Select Case lErrNum
Case E_ABORT:        OLEError = " Aborted"
Case E_ACCESSDENIED: OLEError = " Access Denied"
Case E_FAIL:        OLEError = " General Failure"
Case E_HANDLE:      OLEError = " Bad/Missing Handle"
Case E_INVALIDARG:  OLEError = " Invalid Argument"
Case E_NOINTERFACE:  OLEError = " No Interface"
Case E_NOTIMPL:      OLEError = " Not Implemented"
Case E_OUTOFMEMORY:  OLEError = " Out of Memory"
Case E_POINTER:      OLEError = " Invalid Pointer"
Case E_UNEXPECTED:  OLEError = " Unknown Error"
Case S_OK:          OLEError = " Success!"
End Select
End Function

Anzeige

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
…Dann musst du das auch in den Declare-Anweisgg …
09.01.2019 13:23:39
Luc:-?
…berücksichtigen, Michael;
steht sogar in der VBE-Hilfe zu Declare und immer wieder mal in Forumsbeiträgen, so erst kürzlich!
Gruß, Luc :-?
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 13:46:07
Nepumuk
Hallo Michael,
teste mal. Wenn es nicht klappt, dann müssen wir auf GDI umschalten. Ich habe mitbekommen dass CopyImage unter 64 Bit nicht klappt.
Option Explicit

Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" ( _
    ByVal wFormat As Long) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" ( _
    ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" ( _
    ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
    ByRef PicDesc As uPicDesc, _
    ByRef RefIID As GUID, _
    ByVal fPictureOwnsHandle As Long, _
    ByRef IPic As IPictureDisp) As Long
Private Declare PtrSafe Function CopyEnhMetaFileA Lib "gdi32.dll" ( _
    ByVal hemfSrc As Long, _
    ByVal lpszFile As String) As LongPtr
Private Declare PtrSafe Function CopyImage Lib "user32.dll" ( _
    ByVal handle As LongPtr, _
    ByVal un1 As Long, _
    ByVal n1 As Long, _
    ByVal n2 As Long, _
    ByVal un2 As Long) As LongPtr
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long
Private Declare PtrSafe Function CLSIDFromString Lib "ole32.dll" ( _
    ByVal lpsz As Any, _
    ByRef pCLSID As GUID) As Long

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Type uPicDesc
    lngSize As Long
    lngType As Long
    lnghPic As Long
    lnghPal As Long
End Type

Private Const E_ABORT = &H80004004
Private Const E_ACCESSDENIED = &H80070005
Private Const E_FAIL = &H80004005
Private Const E_HANDLE = &H80070006
Private Const E_INVALIDARG = &H80070057
Private Const E_NOINTERFACE = &H80004002
Private Const E_NOTIMPL = &H80004001
Private Const E_OUTOFMEMORY = &H8007000E
Private Const E_POINTER = &H80004003
Private Const E_UNEXPECTED = &H8000FFFF
Private Const S_OK = &H0

Private Const CF_BITMAP = 2
Private Const CF_PALETTE = 9
Private Const CF_ENHMETAFILE = 14
Private Const IMAGE_BITMAP = 0
Private Const LR_COPYRETURNORG = &H4
Private Const GUID_IPICTUREDISP As String = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}"

Private Const FOLDER_NAME = "H:\"
Private Const FILE_NAME = "Angebot.bmp"

Public Sub Angebot_speichern()
    
    Dim objPicture As IPictureDisp
    Dim lngReturn As Long
    
    Selection.CopyPicture xlScreen, xlBitmap
    
    Set objPicture = Paste_Picture(xlBitmap)
    If Not objPicture Is Nothing Then
        lngReturn = MakeSureDirectoryPathExists(FOLDER_NAME)
        If lngReturn = 0 Then
            MsgBox "Unalble to create folder: '" & FOLDER_NAME & "'.", vbCritical, "Error"
        Else
            stdole.StdFunctions.SavePicture objPicture, FOLDER_NAME & FILE_NAME
        End If
    Else
        MsgBox "Not possible to save picture.", vbCritical, "Error"
    End If
    
End Sub

Function Paste_Picture(Optional lXlPicType As Long = xlPicture) As IPictureDisp
    
    Dim lngReturn As Long, hPtr As LongPtr, hPal As Long
    Dim lngPicType As Long, hCopy As LongPtr
    
    lngPicType = IIf(lXlPicType = xlBitmap, CF_BITMAP, CF_ENHMETAFILE)
    If IsClipboardFormatAvailable(lngPicType) <> 0 Then
        lngReturn = OpenClipboard(Application.hwnd)
        If lngReturn > 0 Then
            hPtr = GetClipboardData(lngPicType)
            If lngPicType = CF_BITMAP Then
                hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
            Else
                hCopy = CopyEnhMetaFileA(hPtr, vbNullString)
            End If
            Call CloseClipboard
            If hPtr <> 0 Then Set Paste_Picture = Create_Picture(hCopy, 0, lngPicType)
        End If
    End If
    
End Function

Private Function Create_Picture( _
        ByVal lnghPic As LongPtr, _
        ByVal lnghPal As Long, _
        ByVal lngPicType As Long) As IPictureDisp

    
    Const PICTYPE_BITMAP = 1
    Const PICTYPE_ENHMETAFILE = 4
    
    Dim lngReturn As Long, uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPictureDisp
    
    Call CLSIDFromString(StrPtr(GUID_IPICTUREDISP), IID_IDispatch)
    
    With uPicInfo
        .lngSize = Len(uPicInfo)
        .lngType = PICTYPE_BITMAP
        .lnghPic = lnghPic
        .lnghPal = lnghPal
    End With
    
    lngReturn = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic)
    If lngReturn <> 0 Then MsgBox "Error occure" & OLEError(lngReturn), vbCritical, "Error"
    Set Create_Picture = IPic
    
End Function

Private Function OLEError(lErrNum As Long) As String
    
    Select Case lErrNum
        Case E_ABORT: OLEError = " Aborted"
        Case E_ACCESSDENIED: OLEError = " Access Denied"
        Case E_FAIL: OLEError = " General Failure"
        Case E_HANDLE: OLEError = " Bad/Missing Handle"
        Case E_INVALIDARG: OLEError = " Invalid Argument"
        Case E_NOINTERFACE: OLEError = " No Interface"
        Case E_NOTIMPL: OLEError = " Not Implemented"
        Case E_OUTOFMEMORY: OLEError = " Out of Memory"
        Case E_POINTER: OLEError = " Invalid Pointer"
        Case E_UNEXPECTED: OLEError = " Unknown Error"
        Case S_OK: OLEError = " Success!"
    End Select
    
End Function

Gruß
Nepumuk
Anzeige
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 20:10:13
Michael
Hallo Nepumuk,
auf der alten Version läuft es durch. Im neuen bleibt er aber hängen in
Function Paste_Picture(Optional lXlPicType As Long = xlPicture) As IPictureDisp
mit dem Hinweis "Fehler beim Kompilieren: Typen unverträglich.
Habe auch die Info gefunden das ich PtrSafe einsetzten muss vor Function
Gruß Foxi
Anzeige
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 20:14:09
Nepumuk
Hallo,
hast du den kompletten Code von mir übernommen oder nur Teile davon?
Gruß
Nepumuk
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 20:22:36
Michael
Hi,
den kompletten Code.
Gruß Michael
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 20:26:29
Nepumuk
Hallo Michael,
dann weiß ich auch nicht weiter, ich habe kein 64Bit Office.
Gruß
Nepumuk
Anzeige
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 20:47:20
Nepumuk
Hallo Michael,
entschuldige dass die letzte Antwort von mir etwas schroff war.
Tritt der Fehler beim Aufruf der Funktion auf oder nachdem sie durchgelaufen ist?
Gruß
Nepumuk
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 20:52:55
Michael
Hi Nepumuk,
Du, wie ich sehe schreibst Du ja hier sehr viel. Und ich kenne es das man da mal genervt ist.
Ich starte das Makro und es kommt kurz darauf die Meldung.
Gruß Michael
Anzeige
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 21:03:56
Nepumuk
Hallo Michael,
geh mal in den VBA-Editor setz den Cursor in die Prozedur Angebot_speichern und steppe mit F8 durch den Code. Was ist die Zeile vor dem Fehler?
Diese?
Set objPicture = Paste_Picture(xlBitmap)
Gruß
Nepumuk
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 21:14:06
Michael
Hi Nepumuk,
genau so wie Du es geschrieben hast. Die Set objPicture = Paste_Picture(xlBitmap) nimmt er, und dann erscheint der Fehler.
Gruß Michael
Anzeige
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 21:17:06
Nepumuk
Hallo Michael,
steht in der 1. Programmzeile von Angebot_speichern das:
Dim objPicture As IPictureDisp
oder das:
Dim objPicture As IPicture
?
Gruß
Nepumuk
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 21:24:05
Michael
Hi Nepumuk,
da steht Dim objPicture As IPictureDisp
Gruß Michael
AW: Fehler wegen 64 Bit bei Makro
09.01.2019 21:28:50
Nepumuk
Hallo Michael,
dann weiß ich wirklich nicht weiter. Die Variable und die Funktion sind vom selben Objekttyp das muss normalerweise gehen. Ich versteh nicht warum es nicht funktioniert. Office 64Bit ist einfach Mist.
Gruß
Nepumuk
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige
Anzeige

Infobox / Tutorial

Fehlerbehebung bei 64 Bit-Problemen in Excel-Makros


Schritt-für-Schritt-Anleitung

Um das Problem mit dem Fehler "Fehler beim Kompilieren: Typen unverträglich" zu beheben, wenn Du ein Excel-Makro unter 64 Bit verwendest, folge diesen Schritten:

  1. Öffne den VBA-Editor: Drücke ALT + F11, um den VBA-Editor zu öffnen.
  2. Finde die Deklaration: Suche nach der Deklaration Deiner Funktionen. Diese sollten das PtrSafe-Schlüsselwort enthalten. Ändere Deine Declare-Anweisungen so, dass sie PtrSafe beinhalten:
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
  3. Anpassung der Funktionsparameter: Stelle sicher, dass alle Funktionsparameter den richtigen Datentyp haben. Bei 64 Bit müssen Pointer als LongPtr deklariert werden:
    Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr) As Long
  4. Verwende LongPtr für Rückgabewerte: Bei Funktionen wie GetClipboardData sollte der Rückgabewert ebenfalls als LongPtr deklariert werden.
  5. Ersetze IPicture durch IPictureDisp: Wenn Du mit Bildobjekten arbeitest, sollten die Variablen vom Typ IPictureDisp anstelle von IPicture sein.
  6. Schreibe Deine Funktionen um: Achte darauf, dass alle Deine Funktionen, die in den Declare-Anweisungen verwendet werden, ebenfalls PtrSafe enthalten.

Häufige Fehler und Lösungen

  • Fehler beim Kompilieren: Wenn Du die Fehlermeldung "Fehler beim Kompilieren: Typen unverträglich" erhältst, überprüfe die Typen Deiner Variablen und die Rückgabewerte. Achte darauf, dass Du LongPtr für 64-Bit-Systeme verwendest.

  • Excel Systemfehler &h80070057: Dieser Fehler tritt häufig auf, wenn ungültige Argumente übergeben werden. Überprüfe alle Argumente in Deinen Funktionen, insbesondere in OpenClipboard und GetClipboardData.

  • Excel Fehler beim Kompilieren 64-bit: Stelle sicher, dass Du in allen Declare-Anweisungen das PtrSafe-Schlüsselwort verwendest, um Kompatibilität mit 64-Bit Excel sicherzustellen.


Alternative Methoden

Falls die oben genannten Lösungen nicht funktionieren, kannst Du alternative Ansätze ausprobieren:

  • Verwendung von GDI: Einige Benutzer haben berichtet, dass die Verwendung von GDI-Funktionen anstelle von CopyImage effektiver ist. Dies könnte die Stabilität Deines Codes verbessern.

  • Nutzung von CLSIDFromString: Diese Funktion kann helfen, wenn Du mit COM-Objekten arbeitest. Stelle sicher, dass Du die Deklaration korrekt anpasst:

    Private Declare PtrSafe Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As String, ByRef pCLSID As GUID) As Long

Praktische Beispiele

Hier ist ein einfaches Beispiel für ein Makro, das eine Auswahl als Bild speichert:

Public Sub Angebot_speichern()
    Dim objPicture As IPictureDisp
    Dim lngReturn As Long
    Selection.CopyPicture xlScreen, xlBitmap
    Set objPicture = Paste_Picture(xlBitmap)
    If Not objPicture Is Nothing Then
        lngReturn = MakeSureDirectoryPathExists("H:\")
        If lngReturn = 0 Then
            MsgBox "Unalble to create folder: 'H:\'.", vbCritical, "Error"
        Else
            stdole.StdFunctions.SavePicture objPicture, "H:\Angebot.bmp"
        End If
    Else
        MsgBox "Not possible to save picture.", vbCritical, "Error"
    End If
End Sub

Achte darauf, dass Du alle Declare-Anweisungen entsprechend anpasst.


Tipps für Profis

  • Debugging: Nutze den Debugger, um durch den Code zu gehen. Setze Haltepunkte (F9) und stepe durch den Code (F8), um die genaue Stelle des Fehlers zu finden.

  • Verwendung von StrPtr und VarPtr: Bei der Arbeit mit Strings und Variablen kannst Du StrPtr und VarPtr verwenden, um die Adressen von Variablen zu überprüfen. Dies kann bei der Fehlersuche hilfreich sein.

  • Regelmäßige Updates: Halte Deine Excel-Version auf dem neuesten Stand, um von den neuesten Funktionen und Bugfixes zu profitieren.


FAQ: Häufige Fragen

1. Muss ich PtrSafe bei allen Funktionen verwenden? Ja, PtrSafe ist notwendig, um sicherzustellen, dass Dein Code sowohl in 32-Bit- als auch in 64-Bit-Versionen von Excel funktioniert.

2. Was ist der Unterschied zwischen IPicture und IPictureDisp? IPictureDisp ist eine spezielle Variante, die in 64-Bit-Versionen verwendet werden sollte, um Kompatibilitätsprobleme zu vermeiden.

3. Was bedeutet der Fehlercode &h80070057? Dieser Fehlercode steht für "Ungültiges Argument". Überprüfe die Argumente, die Du an Deine Funktionen übergibst.

4. Wie kann ich sicherstellen, dass mein Makro in 64-Bit funktioniert? Verwende PtrSafe in allen Declare-Anweisungen und überprüfe, dass Du die richtigen Datentypen wie LongPtr verwendest.

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige