Bild in Zelle mit Bedingungen

Forumthread: Bild in Zelle mit Bedingungen

15.02.2021 09:36:10

Max

Hallo zusammen,
in meiner Beispieldatei soll eines der Bilder in J1 bis M1 in Spalte H eingefügt werden
wenn z.b. C3 ausgefüllt wurde soll in Spalte H in der gleichen Zeile das Bild von J1 eingefügt werden,
wenn auch D3 ausgefüllt wurde soll das Bild in Spalte H ersetzt werden durch das Bild K1,
wenn C3,D3,E3 und F3 ausgefüllt sind soll das Bild in Spalte H ersetzt werden durch das Bild L1,
wenn C3,D3,E3,F3 und G3 ausgefüllt sind soll das Bild in Spalte H ersetzt werden durch das Bild M1.
Hat hierfür jemand eine Lösung?
Vielen Dank für die Hilfe,
hier meine Beispieldatei:
https://www.herber.de/bbs/user/143926.xlsx

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Bild in Zelle mit Bedingungen

15.02.2021 10:12:12

Nepumuk
AW: Bild in Zelle mit Bedingungen

15.02.2021 10:16:54

Nepumuk
AW: Bild in Zelle mit Bedingungen

15.02.2021 10:34:01

ChrisL

AW: Bild in Zelle mit Bedingungen

15.02.2021 10:12:12

Nepumuk

Hallo Max,
Rechtklick auf den Tabellenreiter - Code anzeigen. Folgende Prozeduren einfügen:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lngRow As Long
    Dim objRange As Range, objCell As Range

    Set objRange = Intersect(Target, Range(Cells(3, 3), Cells(Rows.Count, 7)))

    If Not objRange Is Nothing Then

        For Each objCell In objRange

            If objCell.Row <> lngRow Then

                lngRow = objCell.Row

                Select Case Check(lngRow)

                    Case 25

                        Call DeleteShape(lngRow)

                        Call Shapes("Grafik 5").Copy
                        DoEvents
                        Call Paste(Destination:=Cells(objCell.Row, 8))

                    Case 18

                        Call DeleteShape(lngRow)

                        Call Shapes("Grafik 4").Copy
                        DoEvents
                        Call Paste(Destination:=Cells(objCell.Row, 8))

                    Case 7

                        Call DeleteShape(lngRow)

                        Call Shapes("Grafik 3").Copy
                        DoEvents
                        Call Paste(Destination:=Cells(objCell.Row, 8))

                    Case 3

                        Call DeleteShape(lngRow)

                        Call Shapes("Grafik 2").Copy
                        DoEvents
                        Call Paste(Destination:=Cells(objCell.Row, 8))

                    Case 0

                        Call DeleteShape(lngRow)

                End Select
            End If
        Next

        Set objRange = Nothing

        ActiveCell.Select

    End If
End Sub

Private Function Check(ByVal pvlngRow As Long) As Long

    Dim lngColumn As Long

    For lngColumn = 3 To 7

        If Not IsEmpty(Cells(pvlngRow, lngColumn).Value) Then Check = Check + lngColumn

    Next
End Function

Public Sub DeleteShape(ByVal pvlngRow As Long)

    Dim objShape As Shape

    For Each objShape In Shapes

        If objShape.TopLeftCell.Row = pvlngRow Then

            Call objShape.Delete

            Exit For

        End If
    Next

    Set objShape = Nothing

End Sub

Gruß
Nepumuk

AW: Bild in Zelle mit Bedingungen

15.02.2021 10:16:54

Nepumuk

Oooooooooooops,
da ist noch ein Fehler in der Prozedur.
So:

Public Sub DeleteShape(ByVal pvlngRow As Long)

    Dim objShape As Shape

    For Each objShape In Shapes

        With objShape

            If .TopLeftCell.Row = pvlngRow And .TopLeftCell.Column = 8 Then

                Call .Delete

                Exit For

            End If
        End With
    Next

    Set objShape = Nothing

End Sub

Gruß
Nepumuk

AW: Bild in Zelle mit Bedingungen

15.02.2021 10:34:01

ChrisL

Hi Max
Alternativen ohne VBA.
Ich würde eine Variante der bedingten Formatierung (basierend auf ihren Werten formatieren) verwenden.
Im Anhang noch eine andere Möglichkeit mittels verknüpfter Grafik. Im vorliegenden Fall etwas umständlich, weil du für jede Zeile einen neuen Namen definieren müsstest.
https://www.herber.de/bbs/user/143931.xlsx
cu
Chris

Beliebteste Forumthreads (12 Monate)

Forumthread: Bild in Zelle mit Bedingungen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread