Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

Umgang mit dem Variablentyp IPictureDisp


Betrifft: Umgang mit dem Variablentyp IPictureDisp von: Stephan
Geschrieben am: 24.04.2017 16:07:48

Hallo zusammen,

Vor einiger Zeit habe ich mir ein VBA Makro erstellt, mit dem ich mir mehrere Barcodes erstellen und diese an auf Etiketten auf einem A4 Blatt drucken kann. Als Unterstützung zur Erstellung eines Bar Codes habe ich den VBA Quellcode von folgender Seite verwendet:
http://www.die-schwimmers.de/VBA108.htm

Das ganze funktioniert an sich recht zuverlässig. Jedoch gibt es in dem Quellcode einen Punkt den ich gern optimieren möchte.

Es geht um den Variablentyp "IPictureDisp". Dieser wird in dem Ursprungsquellcode dafür genutzt um den erzeugten Barcode aufzunehmen.
In meinem Makro möchte ich gern den erzeugten Barcode als Bild auf einem Tabellenblatt (zum späteren Ausdrucken) ablegen.

Jedoch habe ich bisher keine Möglichkeit gefunden mit dem Variablentyp "IPictureDisp" den erzeugten Barcode direkt auf dem Tabellenblatt abzulegen. Bisher bleibt mir nur umständlich der Weg dies als Bild auf dem Laufwerk abzulegen und dann als Bild wieder in Excel zu importieren.

Zu diesem Thema habe ich eine ganze weile gesucht und rumprobiert, konnte jedoch keine Lösung finden. Daher wäre ich euch sehr dankbar, wenn ihr mir weiterhelfen könntet.

Viele Grüße
Stephan

  

Betrifft: AW: Umgang mit dem Variablentyp IPictureDisp von: Nepumuk
Geschrieben am: 24.04.2017 16:41:53

Hallo,

du kannst das Objekt vom Type IPictureDisp in die Zwischenablage schieben und von dort aus in eine Tabelle einfügen.

Beispiel:

Option Explicit

Private Declare PtrSafe Function DeleteObject Lib "gdi32.dll" ( _
    ByVal hObject As LongPtr) As Long
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 SetClipboardData Lib "user32.dll" ( _
    ByVal wFormat As Long, _
    ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" ( _
    ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long

Private Const IMAGE_BITMAP As Long = 0&
Private Const LR_COPYRETURNORG As Long = &H4
Private Const CF_BITMAP As Long = 2&

Public Sub Test()
    
    Dim lngptrTempPicture As LongPtr
    
    '***************Nur zum testen'***************
    
    Dim objPicture As IPictureDisp
    
    Set objPicture = LoadPicture(Filename:="G:\Eigene Dateien\Eigene Bilder\Zwischenablage01.bmp")
    
    '*********************************************
    
    lngptrTempPicture = CopyImage(objPicture.handle, _
        IMAGE_BITMAP, 0&, 0&, LR_COPYRETURNORG)
    
    If lngptrTempPicture <> 0 Then
        
        Call OpenClipboard(Application.hwnd)
        Call EmptyClipboard
        Call SetClipboardData(CF_BITMAP, lngptrTempPicture)
        Call CloseClipboard
        Call DeleteObject(lngptrTempPicture)
        
        Call Tabelle1.Paste
        
    End If
End Sub

Gruß
Nepumuk


  

Betrifft: Übrigens von: Nepumuk
Geschrieben am: 24.04.2017 17:14:24

Hallo,

du kannst dabei auch die Zelle angeben in die eingefügt werden soll:

With Tabelle1
    Call .Paste(Destination:=.Cells(2, 2))
End With

Gruß
Nepumuk


  

Betrifft: AW: Übrigens von: Stephan
Geschrieben am: 25.04.2017 08:41:15

Guten Morgen,

Vielen Vielen Dank für die schnelle Antwort. Ich habe den Code eben ausprobiert, und siehe da: Er funktioniert! Vielen Vielen Dank, jetzt hat mein Suchen erst einmal ein Ende :)


Eine Frage dazu hätte ich noch: Kann man dem eingefügten Bild noch einen Namen geben, sodass man es später wieder ansteuern kann um es z.B. zu verschieben oder zurecht zu schneiden?


  

Betrifft: AW: Übrigens von: Nepumuk
Geschrieben am: 25.04.2017 10:12:05

Hallo,

klar, so:

With Tabelle1
    Call .Paste(Destination:=.Cells(2, 2))
    .Shapes(.Shapes.Count).Name = "Barcode_1"
End With

Gruß
Nepumuk


  

Betrifft: AW: Übrigens von: Stephan
Geschrieben am: 25.04.2017 17:06:08

Vielen Dank dafür. Das ist genau das was ich gebraucht habe.


Beste Grüße
Stephan