Grafik anzeigen lassen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim Pfad As String, Ext As String, Bild As String Dim RngName As Range, RngBild As Range Set RngName = Range("A1") Set RngBild = Range("C1") Pfad = "D:\Mix\Visitenkarten Prg\" Ext = ".jpg" If Not Intersect(Target, RngName) Is Nothing Then If Target > "" Then 'Prüfung ob Bild zu diesem Namen vorhanden ist Bild = Pfad & Target & Ext If Dir(Bild) = "" Then 'Foto fehlt MsgBox Target & " nicht vorhanden!!!" On Error Resume Next Me.Shapes("Foto").Delete On Error GoTo 0 Else ' Bild vorhanden With Me.Pictures.Insert(Bild) .Name = "Foto" .Left = RngBild.Left .Top = RngBild.Top End With End If Else On Error Resume Next Me.Shapes("Foto").Delete On Error GoTo 0 End If End If End Sub Private Sub Worksheet_Deactivate() On Error Resume Next Me.Shapes("Foto").Delete End Sub

Naja, da musst du erst einmal die Bildchen, die du da haben willst alle auf das entsprechende Tabellenblatt legen.
Die nennst du dann um, oder erfasst einfach die Namen, die oben, neben der Eingabezeile angezeigt werden, wenn du ein Bild anklickst

Dann könntest du in den Code-Bereich des entsprechenden Tabellenblattes etwas sowas rein stellen.
Wobei da zwei Arrays mit deinen Daten zu füllen wären.
Das Erste mit den Namen der Bilder und das zweite mit den entsprechenden Werten von Zelle "A1"
Du kannst auch die Ausrichtung der Bilder verändern. Hier erfolgt das anhand der Position von Zelle "B1"



Private Sub Worksheet_Change(ByVal Target As Range)

    Dim arrWappen() As Variant

    Dim arrText() As Variant

    Dim lngI As Long

    Dim shp As Shape

    

    'Liste der Bilder-Namen

    arrWappen = Array("WP_BW", "WP_BY", "WP_BER")

    'Liste der zugehörigen Werte der Zelle "A1"

    arrText = Array("Baden-Württemberg", "Bayern", "Berlin")

    

    If Target = Range("A1") Then

        For lngI = LBound(arrWappen) To UBound(arrWappen)

            With Shapes(arrWappen(lngI))

                If Range("A1") = arrText(lngI) Then

                    .Visible = msoTrue

                    .Left = Range("B1").Left

                    .Top = Range("B1").Top

                Else

                    .Visible = msoFalse

                End If

            End With

        Next

    End If

End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Grafik anzeigen lassen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread