Bild einfügen mit VBA

Stefan · 2024-05-22T12:28:34+02:00

Hallo zusammen, ich hatte diese Frage schon einmal offen, aber leider keine funktionierende Lösung erhalten. Ist es über VBA möglich folgendes zu steuern (siehe Beispieldatei)? Reiter Tabelle2: Wenn ich bei C4, C5... ein x eintrage, soll dort automatisch anstatt das X, das Bild aus dem Reiter VORLAGE (B2) übernommen werden. https://www.herber.de/bbs/user/169635.xlsx Vielen Dank schon mal im Voraus Beste Grüße Stefan

Hallo Uwe,

vielen Dank, das funktioniert genau so wie ich es wollte.
Für meine Tabelle habe ich es wie folgt angepasst....

Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Bild As Shape: Set Bild = Tabelle3.Shapes("Grafik 14")

    If Not Intersect(Target, Range("C6:C122" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then

        Application.EnableEvents = False

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

        Application.EnableEvents = True

    End If

End Sub

Jetzt würde ich gerne mit einer anderen Grafik in D6:D122 weiter machen.

Option Explicit



Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Bild As Shape: Set Bild = Tabelle3.Shapes("Grafik 16")

    If Not Intersect(Target, Range("D6:D122" & Cells(Rows.Count, 2).End(xlUp).Row)) Is Nothing Then

        Application.EnableEvents = False

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

        Application.EnableEvents = True

    End If

End Sub

wie kann ich diese beiden codes verbinden?

Vielen Dank,
Gruß
Stefan

Hallo

Ich bin zwar der andere Uwe, aber helfe dir auch bei diesem Code gerne weiter.

Tipp vorweg:
Wenn du mit dem Ausschalten von Events arbeitest, solltest du immer eine Fehlerbehandlung mit einbauen, sonst bleiben Diese im Fehlerfall ausgeschaltet und werden nicht weiter ausgeführt.

So?

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo Fehler

    Const APPNAME = "Worksheet_Change"

    Dim Bild As Shape, LR As Long

    LR = Cells(Rows.Count, 2).End(xlUp).Row

    If Not Intersect(Target, Range("C6:C" & LR)) Is Nothing Then

        Set Bild = Tabelle3.Shapes("Grafik 14")

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            Application.EnableEvents = False

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

    End If

        

    If Not Intersect(Target, Range("D6:D" & LR)) Is Nothing Then

        Set Bild = Tabelle3.Shapes("Grafik 16")

        If LCase(Target.Cells) = "x" Then

            Bild.Copy

            Application.EnableEvents = False

            With Target.Cells

                .PasteSpecial

                .Activate

            End With

        End If

    End If

    

    '*** Fehlerbehandlung

    Err.Clear

Fehler:

    Application.EnableEvents = True

    If Err.Number > 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _

        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear

End Sub

Das Festlegen der letzten Zeile habe ich (meiner Meinung nach) berichtigt

LG UweD

Forumthread: Bild einfügen mit VBA

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Bild einfügen mit VBA

Forumthread: Bild einfügen mit VBA

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread