Bild aus Zelle kopieren

Forumthread: Bild aus Zelle kopieren

04.07.2018 15:05:53

Micha

Hallo Profis,
ich habe ein Problem wo ich leider nicht weiterkomme.
ich habe auf dem Blatt "Kartenerstellung" die Zelle $B$2, wo eine Seriennummer steht.
Diese Seriennummer wird mit dem Blatt "Datenbank" Spalte B verglichen. Wenn der Wert darin vorhanden ist, soll die Zelle rechts neben dem gefundenen Wert (zb C7) kopiert und in das Tabellenblatt "Kartenerstellung" in $C$2 eingefügt werden (quasi Sverweis).
Hier bei bisher funktionierendes Makro:

Sub Sortierung()
Dim Teilname As String
Dim Kategorienanzahl As Long
Dim Text As String
Text = Worksheets("Kartenerstellung").Range("B2")
Kategorienanzahl = Worksheets("Datenbank").Cells(Rows.Count, 2).End(xlUp).Row
For j = 4 To Kategorienanzahl
Teilname = Worksheets("Datenbank").Cells(j, 2).Value
Select Case True
Case Text Like "*" & Teilname & "*"
Sheets("Kartenerstellung").Range("C2").Value = Worksheets("Datenbank").Cells(j, 3).Value
End Select
Next j
End Sub

Soweit so gut. Den darin enthaltenen Text übernimmt er ohne Probleme.
Nun beinhaltet die Zelle nicht nur Text, sondern auch ein Bild. Dieses Bild wird jedoch nicht mitkopiert. Es wird nicht auf das Tabellenblatt "Kartenerstellung" eingefügt.
Hat hierzu jemand eine Idee oder bestenfalls eine Lösung?
Danke für eure Hilfe :)
Grüße
Micha

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bild aus Zelle kopieren

07.07.2018 18:03:54

fcs
AW: Bild aus Zelle kopieren

09.07.2018 09:51:23

Micha
AW: Bild aus Zelle kopieren

12.07.2018 08:59:32

Micha
AW: Bild aus Zelle kopieren

12.07.2018 09:05:30

Micha

AW: Bild aus Zelle kopieren

07.07.2018 18:03:54

fcs

Hallo Micha,
bei den normalen Excel-Einstellungen wird beim Kopieren einer Zelle auch ein der Zelle befindliches Object mit kopiert und in der Zielzelle eingefügt - allerding werden dann auch Zellformate mit kopiert.
Diese Einstellung kann man in den Excel-Optionen ändern,
Wenn nur das Bild kopiert werden soll, dann wird es kompliziert.
Da du den Kopiervorgang wahrscheinlich öfter für die gleiche Zielzelle ausführen willst muss vor dem Kopieren ein vorhandenes altes Bild gelöscht werden.
Nachfolgend eine entsprechende Ergänzung zu deinem Makro wobei ich den Kopiervorgang in eine separate Sub ausgelagert habe, so ist es einfach in andere Mappen übertragbar.
Gruß
Franz

Sub Sortierung()
Dim Teilname As String
Dim Kategorienanzahl As Long
Dim Text As String
Dim j As Long
Dim bolFound As Boolean
Text = Worksheets("Kartenerstellung").Range("B2")
With Worksheets("Datenbank")
Kategorienanzahl = .Cells(.Rows.Count, 2).End(xlUp).Row
bolFound = False
For j = 4 To Kategorienanzahl
Teilname = .Cells(j, 2).Value
If Text Like "*" & Teilname & "*" Then
Sheets("Kartenerstellung").Range("C2").Value = .Cells(j, 3).Value
bolFound = True
Call prcCopyShapeObject(Ziel:=Sheets("Kartenerstellung").Range("C2"), _
Quelle:=.Cells(j, 3), TopLeft:=False)
Exit For
End If
Next j
End With
If bolFound = False Then
MsgBox "Kein Treffer zu Wert in B2 gefunden"
End If
End Sub
Public Sub prcCopyShapeObject(Ziel As Range, _
Quelle As Range, TopLeft As Boolean)
'bei TopLeft = True wird das Bild in der linken oberen Ecke der _
Zielzelle eingefügt
Dim objSh As Object
Dim TopDiff As Single
Dim LeftDiff As Single
'vorhandenes Bild in Zielzelle bzw. mit passendem Namen löschen
For Each objSh In Ziel.Parent.Shapes
If objSh.TopLeftCell = Quelle Then
objSh.Delete
Exit For
ElseIf objSh.Name = "Bild_" & Ziel.Address(False, False, xlA1) Then
objSh.Delete
Exit For
End If
Next
'Bild in Quelle suchen und nach Ziel kopieren
For Each objSh In Quelle.Parent.Shapes
'Prüfen, ob die obere linke Zelle des Bildes mit der Quellzelle übereinstimmt
If objSh.TopLeftCell = Quelle Then
With objSh
'Abstände des Bildes zur linken oberen Ecke der Quellzelle merken
TopDiff = .Top - Quelle.Top
LeftDiff = .Left - Quelle.Left
.Copy
End With
With Ziel.Parent
'kopiertes Bild einfügen
.Paste
'eigefügtes Bild (ist normalerweise das letzte Bild im Blatt) _
einer Variablen zuweisen
Set objSh = .Shapes(.Shapes.Count)
With objSh
'Name des eingefügten Bildes neu festlegen (zum Löschen beim _
nächsten Kopiervorgang)
.Name = "Bild_" & Ziel.Address(False, False, xlA1)
'Bild im Zielblatt positionieren
.Top = Ziel.Top + IIf(TopLeft, 0, TopDiff)
.Left = Ziel.Left + IIf(TopLeft, 0, LeftDiff)
End With
End With
Exit For
End If
Next
Ziel.Select
If objSh Is Nothing Then
MsgBox "Kein Bild gefunden"
End If
End Sub

AW: Bild aus Zelle kopieren

09.07.2018 09:51:23

Micha

Hallo Franz,
vielen Dank für deinen Beitrag!
Dein Makro läuft richtig gut! Ich habe es soeben getestet.
Vielen Dank dafür :)
Sollte ich Probleme entdecken, melde ich mich nochmals.
Grüße
Micha

AW: Bild aus Zelle kopieren

12.07.2018 08:59:32

Micha

Hallo Franz,
irgendwie habe ich ein Problem in der Datei.
Wenn die Materialnummern ähnlich sind, bspw. "1234,567" & "1234,568", nimmt er, wenn er nach der 568 suchen soll, die 567.
Gibt es eine Möglichkeit, nach dem exakt zu suchenden Wert zu suchen?
Danke für deine Hilfe :)
Grüße
Micha

AW: Bild aus Zelle kopieren

12.07.2018 09:05:30

Micha

Ich editiere nochmal..
Es sucht schon exakt nach der Nummer. Denn ist diese nicht vorhanden, bringt er mir trotz Ähnlichkeit den Fehler, dass es die Nummer nicht findet. Auch kopiert er nicht das andere Bild mit.
Demnach scheint er ein Problem darin zu haben, das richtige Bild in der Zelle rechts daneben zu greifen und einzufügen.
Grüße
Micha

Infobox / Tutorial

Schritt-für-Schritt-Anleitung

Vorbereitung: Stelle sicher, dass Du die Excel-Datei mit den relevanten Blättern ("Kartenerstellung" und "Datenbank") geöffnet hast.
Makro erstellen: Gehe zu Entwicklertools > Visual Basic, um den VBA-Editor zu öffnen.
Neues Modul: Füge ein neues Modul hinzu: Einfügen > Modul.

Code einfügen: Kopiere den folgenden VBA-Code in das Modul:

Sub Sortierung()
    Dim Teilname As String
    Dim Kategorienanzahl As Long
    Dim Text As String
    Dim j As Long
    Dim bolFound As Boolean
    Text = Worksheets("Kartenerstellung").Range("B2")
    With Worksheets("Datenbank")
        Kategorienanzahl = .Cells(.Rows.Count, 2).End(xlUp).Row
        bolFound = False
        For j = 4 To Kategorienanzahl
            Teilname = .Cells(j, 2).Value
            If Text Like "*" & Teilname & "*" Then
                Sheets("Kartenerstellung").Range("C2").Value = .Cells(j, 3).Value
                bolFound = True
                Call prcCopyShapeObject(Ziel:=Sheets("Kartenerstellung").Range("C2"), _
                Quelle:=.Cells(j, 3), TopLeft:=False)
                Exit For
            End If
        Next j
    End With
    If bolFound = False Then
        MsgBox "Kein Treffer zu Wert in B2 gefunden"
    End If
End Sub

Public Sub prcCopyShapeObject(Ziel As Range, _
Quelle As Range, TopLeft As Boolean)
    Dim objSh As Object
    Dim TopDiff As Single
    Dim LeftDiff As Single
    'vorhandenes Bild in Zielzelle löschen
    For Each objSh In Ziel.Parent.Shapes
        If objSh.TopLeftCell = Quelle Then
            objSh.Delete
            Exit For
        ElseIf objSh.Name = "Bild_" & Ziel.Address(False, False, xlA1) Then
            objSh.Delete
            Exit For
        End If
    Next
    'Bild in Quelle suchen und nach Ziel kopieren
    For Each objSh In Quelle.Parent.Shapes
        If objSh.TopLeftCell = Quelle Then
            With objSh
                TopDiff = .Top - Quelle.Top
                LeftDiff = .Left - Quelle.Left
                .Copy
            End With
            With Ziel.Parent
                .Paste
                Set objSh = .Shapes(.Shapes.Count)
                With objSh
                    .Name = "Bild_" & Ziel.Address(False, False, xlA1)
                    .Top = Ziel.Top + IIf(TopLeft, 0, TopDiff)
                    .Left = Ziel.Left + IIf(TopLeft, 0, LeftDiff)
                End With
            End With
            Exit For
        End If
    Next
    If objSh Is Nothing Then
        MsgBox "Kein Bild gefunden"
    End If
End Sub

Makro ausführen: Schließe den VBA-Editor und führe das Makro über Entwicklertools > Makros aus.

Häufige Fehler und Lösungen

Bild wird nicht kopiert: Stelle sicher, dass das Bild in der Zelle tatsächlich vorhanden ist und dass die Quellzelle korrekt angegeben ist. Es kann hilfreich sein, die Referenzen in Deinem Makro zu überprüfen.
Falsches Bild wird kopiert: Wenn Du ähnliche Materialnummern hast, stelle sicher, dass die Suchlogik exakt ist. Möglicherweise musst Du die Bedingung für die Suche anpassen, um sicherzustellen, dass nur exakte Übereinstimmungen gefunden werden.

Alternative Methoden

Eine alternative Möglichkeit, ein Bild aus einer Zelle zu kopieren, wäre die Verwendung der Excel-Funktion "Einfügen" und das manuelle Auswählen des Bildes. Diese Methode ist jedoch weniger automatisiert und eignet sich nicht für große Datenmengen.

Praktische Beispiele

Angenommen, Du hast in der Zelle B2 eine Seriennummer und in der Zelle rechts davon ein Bild. Mit dem obigen Makro kannst Du das Bild zusammen mit dem Text aus der Zelle C2 der Datenbank in die entsprechenden Zellen der "Kartenerstellung" kopieren.

Tipps für Profis

Effizienz erhöhen: Wenn Du oft Bilder kopierst, kannst Du das Makro anpassen, um mehrere Bilder in einem Durchgang zu verarbeiten, anstatt jedes Mal das gleiche Makro auszuführen.
Fehlerprotokollierung: Füge eine Fehlerprotokollierung in Dein Makro ein, um besser nachverfolgen zu können, wenn etwas schiefgeht.

FAQ: Häufige Fragen

1. Wie kann ich das Bild aus der Zelle in eine andere Zelle kopieren?
Du kannst das Bild in eine andere Zelle kopieren, indem Du die Zielzelle im Makro anpasst. Stelle sicher, dass die Quell- und Zielzellen korrekt definiert sind.

2. Gibt es eine Möglichkeit, nur den Text aus dem Bild zu extrahieren?
Ja, Du kannst OCR-Software verwenden, um den Text aus dem Bild zu extrahieren, bevor Du ihn in Excel einfügst.

3. Funktioniert dieses Makro in allen Excel-Versionen?
Das Makro sollte in den meisten modernen Excel-Versionen (ab 2010) funktionieren. Stelle sicher, dass Du die Entwicklertools aktiviert hast.

Beliebteste Forumthreads (12 Monate)

Forumthread: Bild aus Zelle kopieren

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Bild aus Zelle kopieren in Excel

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread