Microsoft Excel

Herbers Excel/VBA-Archiv

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

Bild aus Userform in Zelle kopieren

Betrifft: Bild aus Userform in Zelle kopieren von: Sleepyhead
Geschrieben am: 30.07.2020 01:58:36

Guten Morgen zusammen,
hoffentlich vorerst die letzte Frage die ich stellen muss.

Meine Tabelle mit Userform funktioniert inzwischen, Bilder können auch angezeigt werden, alles soweit fertig.
Die letzte Hürde an der ich jetzt stehe ist ein Bild aus einer Userform nun in eine spezifische Zelle zu kopieren.

Kann mir jemand eine Möglichkeit geben dies zu bewerkstelligen?

Vielen Dank!
Sleepyhead

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: volti
Geschrieben am: 30.07.2020 09:34:57

Hallo Sleepyhead,

ergänzend zu Deiner Frage "Bildkopie in Userform" hier eine Lösungsidee für den umgekehrten Fall
Der code muss ins Modul zu Deinem bereits vorhandenen code, da dort ja schon alles deklariert wurde.
Lediglich diese Declare musst Du noch ergänzen:
Private Declare PtrSafe Function DeleteObject Lib "gdi32" ( _
        ByVal hObject As LongPtr) As Long
Und das Makro: (das Zielrange anpassen und/oder ggf. noch dynamisieren)
Code in die Zwischenablage
Sub Paste_Picture_FromUserform() hPic = CopyImage(UserForm1.Image3.Picture, _ IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) If hPic <> 0 Then If OpenClipboard(0&) <> 0 Then EmptyClipboard SetClipboardData CF_BITMAP, hPic CloseClipboard DeleteObject hPic ActiveSheet.Paste With Selection .Left = Range("C15").Left .Top = Range("C15").Top End With End If End If End Sub
viele Grüße aus Freigericht
Karl-Heinz


Betrifft: AW: Bild aus Userform in Zelle kopieren
von: Sleepyhead
Geschrieben am: 31.07.2020 02:01:04

Vielen Dank Karl-Heinz,
funktioniert einwandfrei.
Ich habe mich nun daran versucht Bilder von einer Zelle in eine andere direkt darunter liegend zu verschieben, bin leider schon wieder daran gescheitert... Ich habe es zwar hinbekommen, dass die Bilder kopiert werden, aber wenn ich ein neues Bild speicher, dann überspeichert mir der Sub sämtliche bereits vorhandenen Zellen.

Ich möchte im Endeffekt erreichen, dass ich bei jeder neuen Suche in meiner Userform über einen Command_Button diese Suche speichern kann. Durch deine erstklassige Hilfe funktioniert das auch wunderbar mit einer einzigen Suche.

Nun möchte ich erreichen, dass 20 Suchen gespeichert werden können und die letzte immer ganz oben steht. Wie kann ich nun erreichen, dass ein Bild erst in die nächste Zeile transferiert, dann in der vorherigen Zeile gelöscht und daraufhin das nächste Bild dort eingefügt wird?

Vielen Dank für deine Hilfe!

LG
Sleepyhead

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: volti
Geschrieben am: 31.07.2020 12:17:02

Hallo Sleepyhead,

falls ich das richtig verstanden habe, möchtest Du das Bild aus der Userform immer oben in einer Reihe von 20 Bildern einfügen. Vorher sollen die Grafiken verschoben und die letzte gelöscht werden.

Schau mal, ob nachfolgendes Makro dazu geeignet ist:
Code in die Zwischenablage[+][-]
Sub Paste_Picture_From_Userform() 'Makro löscht die letzte Grafik, verschiebt die Verbliebenen nach unten 'und fügt oben die aktuelle Grafik aus einer Userform wieder ein Dim iZeile As Long, iSpalte As Long, yBeginn As Long, yEnde As Long Dim oShp As Object, rRette As Range Dim xPt As Double, yPt As Double 'Hier die Parameter eingeben yBeginn = 1: yEnde = 20: iSpalte = 3 'Grafiken in Spalte $C Set rRette = ActiveCell 'Aktive Zelle retten hPic = CopyImage(UserForm1.Image1.Picture, _ IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) 'Bild kopieren If hPic <> 0 Then If OpenClipboard(Application.hWnd) <> 0 Then 'Zwiscehnablage öffnen EmptyClipboard 'Zwischenablage leeren SetClipboardData CF_BITMAP, hPic 'Bild in Zwischenablage setzen CloseClipboard 'Zwischenablage schließen DeleteObject hPic 'Temporäres Bild löschen 'Alle Grafiken um eine Zeile nach unten schieben For iZeile = yEnde To yBeginn Step -1 'Alle Zeilen durchgehen For Each oShp In ActiveSheet.Shapes 'Je Zeile alle Shapes durchgehen With oShp xPt = Cells(iZeile, iSpalte).Left - 1 'xPosition der Zelle yPt = Cells(iZeile, iSpalte).Top - 1 'yPosition der Zelle If .Left > xPt And .Top > yPt And .Left < xPt + 6 And .Top < yPt + 6 Then If iZeile = yEnde Then .Delete 'erste bzw. letzte Grafik entfernen Else .Top = Cells(iZeile + 1, iSpalte).Top 'Shape verschieben End If Exit For 'Dieses Shape ist erledigt End If End With Next oShp Next iZeile 'Neue Grafik vorne einfügen und formatieren ActiveSheet.Paste With Selection .Left = Cells(yBeginn, iSpalte).Left .Top = Cells(yBeginn, iSpalte).Top If .Width < .Height Then .Width = Cells(yBeginn, iSpalte).Width 'Verhältnis bleibt gleich Else .Height = Cells(yBeginn, iSpalte).Height End If End With rRette.Select 'Position wiederherstellen End If 'If OpenClipboard End If 'If hPic <> 0 End Sub
viele Grüße aus Freigericht
Karl-Heinz


Betrifft: AW: Bild aus Userform in Zelle kopieren
von: volti
Geschrieben am: 31.07.2020 19:42:04

Hallo Sleepyhead,

hier noch eine Variante, bei der die Grafiken auch in einem nicht aktivierten Blatt eingefügt werden kann.

Code in die Zwischenablage[+][-]
Sub Paste_Picture_From_Userform() 'Makro löscht die letzte Grafik, verschiebt die Verbliebenen nach unten 'und fügt oben die aktuelle Grafik aus einer Userform wieder ein Dim iZeile As Long, iSpalte As Long, yBeginn As Long, yEnde As Long Dim oShp As Object, oLastShp As Object, rRette As Range Dim WSh As Worksheet Dim xPt As Double, yPt As Double 'Hier die Parameter eingeben yBeginn = 1: yEnde = 20: iSpalte = 3 'Grafiken in Spalte $C Set WSh = ActiveSheet 'Zielblatt angeben If WSh Is ActiveSheet Then Set rRette = ActiveCell 'Aktive Zelle retten hPic = CopyImage(UserForm1.Image1.Picture, _ IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG) 'Bild kopieren If hPic <> 0 Then If OpenClipboard(Application.hWnd) <> 0 Then 'Zwiscehnablage öffnen EmptyClipboard 'Zwischenablage leeren SetClipboardData CF_BITMAP, hPic 'Bild in Zwischenablage setzen CloseClipboard 'Zwischenablage schließen DeleteObject hPic 'Temporäres Bild löschen 'Alle Grafiken um eine Zeile nach unten schieben For iZeile = yEnde To yBeginn Step -1 'Alle Zeilen durchgehen For Each oShp In WSh.Shapes 'Je Zeile alle Shapes durchgehen With oShp xPt = WSh.Cells(iZeile, iSpalte).Left - 1 'xPosition der Zelle yPt = WSh.Cells(iZeile, iSpalte).Top - 1 'yPosition der Zelle If .Left > xPt And .Top > yPt And .Left < xPt + 6 And .Top < yPt + 6 Then If iZeile = yEnde Then .Delete 'erste bzw. letzte Grafik entfernen Else .Top = WSh.Cells(iZeile + 1, iSpalte).Top 'Shape verschieben End If Exit For 'Dieses Shape ist erledigt End If End With Next oShp Next iZeile 'Neue Grafik vorne einfügen und formatieren WSh.Paste Destination:=WSh.Cells(yBeginn, iSpalte) For Each oShp In WSh.Shapes Set oLastShp = oShp 'Zuletzt eingefügte Grafik Next oShp With oLastShp .Left = WSh.Cells(yBeginn, iSpalte).Left .Top = WSh.Cells(yBeginn, iSpalte).Top If .Width < .Height Then .Width = WSh.Cells(yBeginn, iSpalte).Width 'Verhältnis bleibt gleich Else .Height = WSh.Cells(yBeginn, iSpalte).Height End If End With If Not rRette Is Nothing Then rRette.Select 'Position wiederherstellen End If 'If OpenClipboard End If 'If hPic <> 0 End Sub
viele Grüße aus Freigericht
Karl-Heinz


Betrifft: AW: Bild aus Userform in Zelle kopieren
von: Sleepyhead
Geschrieben am: 01.08.2020 00:51:55

Guten Morgen Karl-Heinz,

vielen Dank für deinen Lösungsvorschlag, leider funktioniert es noch nicht so, wie ich das gerne hätte...

https://www.herber.de/bbs/user/139408.xls /PW: Sleepyhead

Anbei habe ich dir einmal eine gekürzte Tabelle hochgeladen mit nur einem Sheet zum eintragen und 3x100 Eintragsmöglichkeiten statt 2 Sheets mit je 100x100 Eintragsmöglichkeiten.

Vieleicht habe ich mich auch unklar ausgedrückt.

Das Bild aus der Userform soll in den letzten Suchen in dem Sheet "Matrix" immer ganz oben eingefügt werden, auch wenn dort noch keine Einträge vorhanden sind.

Was nun geschehen soll sobald die nächste Suche in der Userform gespeichert wird ist, dass der Eintrag in der obersten Zeile in die nächste kopiert wird und dabei in der oberen Zeile, in der die neue Suche hinterlegt wird das Bild gelöscht wird, da dieses ja nicht einfach so überschrieben werden kann wie z.B. Texte.

Somit soll man die letzten 20 gespeicherten Suchen nachvollziehen können und dies von oben (letzter Eintrag) nach unten (quasi der erste Eintrag).

Im einfachen ausgedrückt:
Der Command_Button der Userform soll bewirken, dass eine komplette Zeile in die nächste kopiert wird und der nächste Eintrag in der ersten Zeile abgespeichert wird.

Mit deinem Lösungsvorschlag hatte ich dasselbe Problem wie mit meinem eigenen Versuch, sobald ich einen Eintrag mit einem Bild speicher wird das Bild in sämtlichen Zeilen gespeichert.

Ich wäre sehr dankbar, wenn du mir nochmal helfen könntest ;)

Vielen Dank und schöne Grüße

Sleepyhead

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: volti
Geschrieben am: 01.08.2020 08:51:46

Moin,

ohne Datei kann ich Deinen Wünschen nicht so recht folgen und die Datei kann ich nicht öffnen....
Falsches Format.

VG KH

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: Sleepyhead
Geschrieben am: 01.08.2020 21:08:19

Guten Abend Karl-Heinz,

welches Format würdest du denn benötigen?
Anbei dasselbe mal in anderen Excel-Formaten.

https://www.herber.de/bbs/user/139413.xlsm

https://www.herber.de/bbs/user/139414.xlt

Ansonsten versuche ich mal mein Problem hier Bildhaft zu verdeutlichen.


Userform:

Hier wird dank deines Codes ein Bild aus einer Tabelle angezeigt und per Button_click auf Wunsch abgespeichert.


Sheet "Matrix" Cells(J8):

Hier wird das erste Bild der Suche gespeichert.


Sheet "Matrix" Cells(J9):

Bei der nächsten Suche soll das Bild aus J8 hierher kopiert werden und in J8 ein neues eingefügt werden wobei das alte aus dieser Zelle gelöscht wird.


Sheet "Matrix" Range(J8:J27):

Dies ist der gesamte Speicherbereich für die Bilder der Suchen.
Wenn sämtliche Suchzeilen belegt sind, dann soll das Bild in der untersten Zelle(J27), somit das erste welches gespeichert wurde, gelöscht werden.


Was aktuell passiert:

Wenn ich aus der Userform ein Bild speicher, dann wird dieses in sämtliche Zellen in der Range(J8:J27) eingefügt.


Ich hoffe, dass ich dier so mein Problem besser beschreiben konnte.

ICh danke dir vielmals für deine Hilfsbereitschaft ;)

LG
Sleepyhead

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: volti
Geschrieben am: 01.08.2020 22:27:56

Hallo,

Zwischeninfo:

Kann die Datei jetzt öffnen, mich aber wohl erst morgen damit beschäftigen....

Wenn ich aus der Userform ein Bild speicher, dann wird dieses in sämtliche Zellen in der Range(J8:J27) eingefügt.
Das kann ich gar nicht glauben. Bei mir werden alle vorhandenen Grafiken jeweils eine Zeile runtergesetzt und oben das neue eingefügt, das letzte gelöscht. Somit ist jede Grafik nur einmal vorhanden.
Aber gut, das schaue ich mir mal in Deiner Datei dann an.

VG KH

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: volti
Geschrieben am: 02.08.2020 12:30:31

Hallo Sleepyhead,

anliegend Deine Datei zurück. Da ich umfangreiche Änderungen vorgenommen habe, bitte Deine alte Datei sichern.
Um ein wenig zu verstehen, was Du da machst, musste ich den Code analysieren und habe deshalb (hoffentlich in Deinem Sinne), das deutlich vereinfacht.
Den Teil mit dem Verschieben der Grafiken (der hat schon funktioniert) hattest Du leider nicht ganz richtig angewendet.
Auch brauchst Du den API-Kram nicht vierfach. Einmal reicht, wenn man es dann mit den richtigen Parametern aufruft.
Schaun halt mal rein in die Datei und teste, ob es jetzt weitgehend funktioniert. Da hatte ich jetzt gerade Muße zu.

SleepyHeads Datei

Viel Spaß und Gruß aus Hessen
Karl-Heinz

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: volti
Geschrieben am: 02.08.2020 18:13:04

Kleines Update mit etwas mehr Sicherheit beim Bild kopieren

Sleepyheads Datei

VG KH

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: Sleepyhead
Geschrieben am: 03.08.2020 03:23:21

Vielen vielen Dank für deine Mühe Karl-Heinz,

dein Update funktioniert einwandfrei, bei der ersten Datei hatte ich wieder denselben Fehler wie zuvor, das Bild aus der Matrix wurde kopiert und auch beim Speichern verschoben, aber das Bild aus einem der Worksheets hat sich einfach immer an derselben stelle überkopiert und hat sich nicht mit verschoben.

Deine Erklärungen im Code selbst sind erstklassig, vielen Dank, dass du dir so viel Mühe gemacht hast meinen Quatsch zu analysieren und zusätzlich das ganze zu überarbeiten.

Durch deine Art des Schreibens des Codes habe ich wieder einiges dazugelernt!

Danke, dass du dir soviel Zeit für mich genommen hast.

Liebe Grüße
Sleepyhead

Betrifft: AW: Bild aus Userform in Zelle kopieren
von: Nepumuk
Geschrieben am: 30.07.2020 09:39:14

Hallo Sleepyhead,

teste mal:

Option Explicit

Private Declare Function DeleteObject Lib "gdi32.dll" ( _
    ByVal hObject As Long) As Long
Private Declare Function CopyImage Lib "user32.dll" ( _
    ByVal handle As Long, _
    ByVal imageType As Long, _
    ByVal newWidth As Long, _
    ByVal newHeight As Long, _
    ByVal lFlags As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" ( _
    ByVal wFormat As Long, _
    ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32.dll" ( _
    ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long

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

Private Sub Image1_Click()
    Dim lngTempPicture As Long
    lngTempPicture = CopyImage(Image1.Picture, _
        IMAGE_BITMAP, 0&, 0&, LR_COPYRETURNORG)
    If lngTempPicture <> 0& Then
        Call OpenClipboard(Application.hwnd)
        Call EmptyClipboard
        Call SetClipboardData(CF_BITMAP, lngTempPicture)
        Call CloseClipboard
        On Error Resume Next
        With Tabelle1
            Do
                Call Err.Clear
                Call .Paste(Destination:=.Cells(1, 1))
            Loop Until Err.Number = 0
        End With
        Call DeleteObject(lngTempPicture)
        With Selection
            .Top = Cells(1, 1).Top + Cells(1, 1).Height / 2 - .Height / 2
            .Left = Cells(1, 1).Left + Cells(1, 1).Width / 2 - .Width / 2
        End With
    End If
End Sub


Betrifft: AW: Bild aus Userform in Zelle kopieren
von: Sleepyhead
Geschrieben am: 31.07.2020 02:03:38

Danke auch an dich Nepumuk,

ich habe den Vorschlag von Karl-Heinz / volti genommen, da er mir bereits zuvor eine Möglichkeit
gegeben hat Bilder aus einer Zelle in eine Userform zu integrieren.

Trotzdem vielen Dank für deine Mühe ;)

LG
Sleepyhead

Beiträge aus dem Excel-Forum zum Thema "Bild aus Userform in Zelle kopieren"