Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1552to1556
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Umgang mit dem Variablentyp IPictureDisp

Umgang mit dem Variablentyp IPictureDisp
24.04.2017 16:07:48
Stephan
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

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Umgang mit dem Variablentyp IPictureDisp
24.04.2017 16:41:53
Nepumuk
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
Anzeige
Übrigens
24.04.2017 17:14:24
Nepumuk
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
AW: Übrigens
25.04.2017 08:41:15
Stephan
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?
Anzeige
AW: Übrigens
25.04.2017 10:12:05
Nepumuk
Hallo,
klar, so:
With Tabelle1
    Call .Paste(Destination:=.Cells(2, 2))
    .Shapes(.Shapes.Count).Name = "Barcode_1"
End With

Gruß
Nepumuk
AW: Übrigens
25.04.2017 17:06:08
Stephan
Vielen Dank dafür. Das ist genau das was ich gebraucht habe.
Beste Grüße
Stephan
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige