Microsoft Excel

Herbers Excel/VBA-Archiv

Bilder dynamisch per vba kopieren

Betrifft: Bilder dynamisch per vba kopieren von: dominik
Geschrieben am: 06.02.2020 10:16:17

Hallo,


ich habe folgendes Problem, ich gebe in e8:e31 einen Text ein den er dann mit be8:be31 vergleichen soll und dann die zelle be8:be31 wo ein bild drauf liegt, die zelle kopiert und in c8:c31 einfügt. Jetzt habe ich folgenden Code gefunden der mir Bilder aus einem Ortner einfügt was auch sehr gut funktioniert, jedoch finde ich es besser wenn die Bilder in der Exceldatei in einem Tabellenblatt liegen und er sie von dort aus aus der zelle kopiert. Hierfür habe ich auch einen Code gefunden, dieser wenn er durchläuft die zellen be8:be31 wo der text drin steht der mit e8:e31 verglichen wird und dann wird be8:be31 mit dem bild das über der zelle liegt kopiert, allerdings doppelt.


Erster Code Bild aus Datei:

Sub BildFenster()
Dim picBild As Picture
Dim rngZelle As Range
Dim strFenster As String
Dim strDatei As String


For i = 8 To 31

strFenster = Cells(i, 5).Value
strDatei = strFenster & ".jpg"
Set rngZelle = Worksheets("angebot").Cells(i, 3)


If Cells(i, 5).Value <> " " Then

Set picBild = Worksheets("angebot").Pictures.Insert("C:\users\marcel brandner\desktop\neuer  _
ordner\" & strDatei)
picBild.Top = rngZelle.Top
picBild.Left = rngZelle.Left

End If
Next
End Sub

zweiter Code der die zellen doppelt kopiert:
Sub aktBestandsDaten()
Dim Gesucht As Variant
Dim Gefunden As Variant






    For i = 8 To 9
    Gesucht = Sheets("Angebot").Cells(i, 5).Value
   
        Gefunden = Sheets("Angebot").Cells(i, 57).Value
            If Gesucht = Gefunden Then
            Sheets("Angebot").Range(Cells(i, 57), Cells(i, 57)).Copy Destination:=Sheets(" _
Angebot").Range(Cells(i, 3), Cells(i, 3))
                
            End If
        Next
End Sub

Es ist bestimmt nur eine Kleinigkeit die ich ändern muss, ich komme einfach nicht drauf, hoffe mir kann jemand helfen.


Gruß

Dominik

Betrifft: AW: Bilder dynamisch per vba kopieren
von: Beverly
Geschrieben am: 06.02.2020 15:14:31

Hi Dominik,

sind e8:e31 und c8:c31 und be8:be31 jeweils verbundene Zellen?


GrußformelBeverly's Excel - Inn

Betrifft: AW: Bilder dynamisch per vba kopieren
von: dominik
Geschrieben am: 06.02.2020 19:09:22

Hallo Karin,

es sind keine verbunden Zellen und auch keine leeren Zellen sind dabei. Im Prinzip soll es so funktionieren wie der erste code den ich geschickt habe, der funktioniert prima, nur soll er das Bild nicht aus einem Ordner einfügen sondern soll die entsprechende Zelle kopieren und einfügen. in den Zellen e8:e31 steht Text drin, den soll er mit dem Text in Zellen be8:be31 vergleichen, auf diesen Zellen liegen die Bilder, und wenn der Wert passt soll die Zelle kopiert werden nach c8:c31

gruß
dominik

Betrifft: AW: Bilder dynamisch per vba kopieren
von: Beverly
Geschrieben am: 06.02.2020 22:58:11

Hi Dominic,

lade doch einfach mal eine Beispielmappe mit ein paar wenigen Bildern hoch damit man mal sehen kann, was genau du wie meinst.


GrußformelBeverly's Excel - Inn

Betrifft: AW: Bilder dynamisch per vba kopieren
von: dominik
Geschrieben am: 07.02.2020 08:26:09

Hallo Karin,

anbei ist eine Beispielmappe mit den beiden Codes.

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

Gruß
dominik

Betrifft: AW: Bilder dynamisch per vba kopieren
von: Beverly
Geschrieben am: 07.02.2020 09:50:39

Hi Dominik,
Sub aktBestandsDaten()
    Dim shaShape As Shape
    With Worksheets("Angebot")
        For i = 8 To 9
            If .Cells(i, 5).Value = .Cells(i, 57).Value Then
                For Each shaShape In .Shapes
                    If shaShape.TopLeftCell.Address = .Cells(i, 3).Address Then
                        shaShape.Delete
                        Exit For
                    End If
                Next shaShape
                .Range(Cells(i, 57), Cells(i, 57)).Copy _
                    Destination:=.Range(Cells(i, 3), Cells(i, 3))
            End If
        Next i
    End With
End Sub

GrußformelBeverly's Excel - Inn

Betrifft: AW: Bilder dynamisch per vba kopieren
von: dominik
Geschrieben am: 07.02.2020 12:26:20

Hallo Karin,

vielen Dank für deine Rückmeldung. Im Prinzip soll es genauso funktionieren. Das einzige Problem was noch nicht ganz funktioniert ist das wenn das Makro einmal durchläuft ich in Zeile 8 zweimal das Bild eingefügt bekomme. Wenn das Makro von Zeile 8 bis 10 laufen soll, dann habe ich in Zeile 10 ein Bild und in Zeile 8 und 9 zwei Bilder. Weißt vllt wie man das beheben kann, sodass in Zeile 8 bis … das Bild jeweils nur einmal eingefügt wird.

Gruß
dominik

Betrifft: AW: Bilder dynamisch per vba kopieren
von: dominik
Geschrieben am: 07.02.2020 12:54:20

Hallo Karin,

es treten leider noch mehrere Fehler auf. Sobald ich das ganze z.B. von Zeile 8 bis 12 durchlaufen lasse, kopiert er mir nicht mehr die richtigen Bilder, fügt Bilder doppelt ein und lässt das Bild in Zeile 8 ganz weg.

Gruß
dominik

Betrifft: AW: Bilder dynamisch per vba kopieren
von: dominik
Geschrieben am: 07.02.2020 12:59:33

Hallo Karin,

sorry mir ist noch was aufgefallen. Es muss quasi eine index vergleich formel sein, da die werte in spalte 5 nicht variieren können und nicht immer an der gleichen stellen stehen. Dein Code funktioniert nur wenn der wert in spalte e8 gleich be8 ist.

Danke für deine Mühen

Gruß
Dominik

Betrifft: AW: Bilder dynamisch per vba kopieren
von: Beverly
Geschrieben am: 07.02.2020 14:19:01

Hi Dominik,
Sub aktBestandsDaten()
    Dim shaShape As Shape
    Dim rngSuche As Range
    Dim i As Long
    Application.ScreenUpdating = False
    With Worksheets("Angebot")
        lngLetzte = .Columns(5).Find(What:="*", SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious).Row
        For i = 8 To lngLetzte
            If .Cells(i, 5).Value <> "" Then
                If .Cells(i, 3) <> .Cells(i, 5) Then
                    Set rngSuche = .Columns(57).Find(.Cells(i, 5).Value, _
                        lookat:=xlWhole, LookIn:=xlValues)
                    If Not rngSuche Is Nothing Then
                        For Each shaShape In .Shapes
                            If shaShape.TopLeftCell.Address = .Cells(i, 3).Address Then
                                shaShape.Delete
                                Application.Wait Now + TimeValue("00:00:01")
                                Exit For
                            End If
                        Next shaShape
                        rngSuche.Copy _
                            Destination:=.Cells(i, 3)
                    End If
                End If
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub

GrußformelBeverly's Excel - Inn

Betrifft: AW: Bilder dynamisch per vba kopieren
von: dominik
Geschrieben am: 07.02.2020 19:54:55

Hallo Karin,

kannst du dein makro vllt mal testen, ich bin anscheinend zu blöd es funktioiert leider immer noch nicht. wenn ich text in e8:e12 schreibe kopiert er die bilder immer dopplet übereinander. in e8:e12 kann stehen fen100, fen101, fen201, fen111 … diese stehen auch in den zellen be8:be12.

oder ist vllt noch jemand im Forum der weiterhelfen kann.bin über jeden rat sehr dankbar.

gruß
dominik

Betrifft: AW: Bilder dynamisch per vba kopieren
von: Beverly
Geschrieben am: 07.02.2020 20:16:22

Sorry, da waren noch 2 überflüssige Zeilen drin. Ändere die Schleife wie folgt:
        For i = 8 To lngLetzte
            If .Cells(i, 5).Value <> "" Then
                Set rngSuche = .Columns(57).Find(.Cells(i, 5).Value, _
                    lookat:=xlWhole, LookIn:=xlValues)
                If Not rngSuche Is Nothing Then
                    For Each shaShape In .Shapes
                        If shaShape.TopLeftCell.Address = .Cells(i, 3).Address Then
                            shaShape.Delete
                            Application.Wait Now + TimeValue("00:00:01")
                            DoEvents
                            Exit For
                        End If
                    Next shaShape
                    rngSuche.Copy _
                        Destination:=.Cells(i, 3)
                End If
            End If
        Next i

GrußformelBeverly's Excel - Inn

Betrifft: AW: Bilder dynamisch per vba kopieren
von: dominik
Geschrieben am: 07.02.2020 21:05:29

Hallo Karin,

es funktioniert fast. also er macht folgendes was ich nicht verstehe. in die 8 Zeile kopiert er immer erst das Bild mit dem wert fen100 und dann das richtige Bild von z.B. fen101 drüber und in der Zeile 10 kopiert er erst das richtige Bild und dann nochmal ein anderes Bild drüber.

gruß
dominik

Betrifft: AW: Bilder dynamisch per vba kopieren
von: Beverly
Geschrieben am: 07.02.2020 21:30:36

Hi Dominik,

das liegt irgendwie an der Art des Kopieren und am Bildschirmaufbau, denn wenn man im Einzelschrittmodus durchgeht funktioniert alles korrekt. Aber versuche es mal so:
        For i = 8 To lngLetzte
            If .Cells(i, 5).Value <> "" Then
                Set rngSuche = .Columns(57).Find(.Cells(i, 5).Value, _
                    lookat:=xlWhole, LookIn:=xlValues)
                If Not rngSuche Is Nothing Then
                    For Each shaShape In .Shapes
                        If shaShape.TopLeftCell.Address = .Cells(i, 3).Address Then
                            shaShape.Delete
                            DoEvents
                            Exit For
                        End If
                    Next shaShape
                    For Each shaShape In .Shapes
                        If shaShape.TopLeftCell.Address = rngSuche.Address Then
                            shaShape.Copy
                            .Cells(i, 3).PasteSpecial Paste:=xlAll
                            DoEvents
                            .Cells(i, 3) = rngSuche.Value
                            Exit For
                        End If
                    Next shaShape
                End If
            End If
        Next i

GrußformelBeverly's Excel - Inn

Betrifft: AW: Bilder dynamisch per vba kopieren
von: dominik
Geschrieben am: 07.02.2020 22:19:22

Hallo Karin,

es tut mir mega leid, es war mein Fehler, ich hatte die Zellen nicht groß genug gehabt, sodass die Bilder teilweise über zwei Zellen lagen und folglich hat er zwei Bilder kopiert und in die jeweilige Zelle eingefügt. Dein vorletzter code funktioniert, dein letzter code funktioniert noch besser. Vielen dank für deine Geduld und deine Mühen.

Gruß
dominik

Beiträge aus dem Excel-Forum zum Thema "Bilder dynamisch per vba kopieren"