Hi @ll
Ist es möglich, einem Zellenwert in einer anderen Zelle eine Grafik zuzuordnen?
Z.B.: In Zelle A1 steht der Wert 1 und ich möchte, dass dann in Zelle B1 die Grafik „ab“ aus einer Liste aus Grafiken erscheint; in Zelle A2 steht der Wert 2 und in Zelle B2 soll die Grafik „cd“ erscheinen.
Im Prinzip ein wenig wie eine bedingte Formatierung…
Danke für Hilfe…
Schöne Grüsse, L_A
Hi Lucky,
Ist es möglich, einem Zellenwert in einer anderen Zelle eine
Grafik zuzuordnen?
ja
Z.B.: In Zelle A1 steht der Wert 1 und ich möchte, dass dann
in Zelle B1 die Grafik „ab“ aus einer Liste aus Grafiken
erscheint; in Zelle A2 steht der Wert 2 und in Zelle B2 soll
die Grafik „cd“ erscheinen.
wie/was genau meinst du mit
###die Grafik „ab“ aus einer Liste aus Grafiken ###
Genauer gefragt, willst du in A1 ne 1 oder 2 oder 3 usw eingeben und dementsprechend soll eine Grafik in B1 erscheinen, oder willst du in A1 eine Auswahlbox wo du 1 oder 2 oder 3 usw auswählst und dann…
Also please, mehr Butter to the Fische 
Gruß
Reinhard
Guten Morgen! Sorry, wenn ich unpräzise war…
Das Erstere möchte ich erreichen… ich will in A1 ne 1 oder 2 oder 3 usw eingeben und dementsprechend soll eine Grafik in B1 erscheinen; eine bestimmte für den Wert 1, eine andere für den Wert 2 usw.
Danke für Deine Hilfe,
Lucky
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Das Erstere möchte ich erreichen… ich will in A1 ne 1 oder 2
oder 3 usw eingeben und dementsprechend soll eine Grafik in B1
erscheinen; eine bestimmte für den Wert 1, eine andere für den
Wert 2 usw.
Hi Lucky,
in den Codebereich von Tabelle1:
Option Explicit
Private Sub Worksheet\_Change(ByVal Target As Range)
Dim Pfad As String
If Target.Column 1 Then Exit Sub
Application.ScreenUpdating = False
Pfad = "C:\Dokumente und Einstellungen\All Users\Dokumente\Eigene Bilder\Beispielbilder\"
Select Case Target.Value
Case 1
ActiveSheet.Pictures.Insert(Pfad & "winter.jpg").Select
Case 2
ActiveSheet.Pictures.Insert(Pfad & "Sonnenuntergang.jpg").Select
Case 3
ActiveSheet.Pictures.Insert(Pfad & "Blaue Berge.jpg").Select
Case Else
ActiveSheet.Pictures.Insert(Pfad & "NixZuSehen.jpg").Select
End Select
With Selection
.Top = Range("B" & Target.Row).Top
.Left = Range("B" & Target.Row).Left
.Height = Range("B" & Target.Row).Height
.Width = Range("B" & Target.Row).Width
End With
Target.Offset(1, 0).Select
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
hallo,
mich würd das ganze auch interssieren, jetzt hab ich nur ein problem:
wenn ich in die selbe zelle mehrmals hintereinander ausfülle, wird jedesmal eine neue grafik eingefügt und über die alte gelegt.
gibt es eine möglichkeit, dass die alte grafik zunächst entfernt wird?
mich würd das ganze auch interssieren, jetzt hab ich nur ein
problem:
wenn ich in die selbe zelle mehrmals hintereinander ausfülle,
wird jedesmal eine neue grafik eingefügt und über die alte
gelegt.
gibt es eine möglichkeit, dass die alte grafik zunächst
entfernt wird?
Hi Joachim,
Option Explicit
Dim Namen(1000) As String
Private Sub Worksheet\_Change(ByVal Target As Range)
' beim Code half mit K.Rola, Danke dafür
Const PFAD As String = "C:\Dokumente und Einstellungen\All Users\Dokumente\Eigene Bilder\Beispielbilder\"
Dim Pic As Picture, B As Shape
If Target.Column \> 1 Or Target.Cells.Count \> 1 Then Exit Sub
Application.ScreenUpdating = False
For Each B In ActiveSheet.Shapes
If B.Name = Namen(Target.Row) Then
ActiveSheet.Shapes(B.Name).Delete
Exit For
End If
Next B
Select Case Target.Value
Case 1
Set Pic = Me.Pictures.Insert(PFAD & "winter.jpg")
Pic.Name = Target.Row & "Billd" & Target.Value
Namen(Target.Row) = Pic.Name
Case 2
Set Pic = Me.Pictures.Insert(PFAD & "Sonnenuntergang.jpg")
Pic.Name = Target.Row & "Billd" & Target.Value
Namen(Target.Row) = Pic.Name
Case 3
Set Pic = Me.Pictures.Insert(PFAD & "Blaue Berge.jpg")
Pic.Name = Target.Row & "Billd" & Target.Value
Namen(Target.Row) = Pic.Name
Case Else
Exit Sub
End Select
With Pic
.Top = Range("B" & Target.Row).Top
.Left = Range("B" & Target.Row).Left
.Height = Range("B" & Target.Row).Height
.Width = Range("B" & Target.Row).Width
End With
Target.Offset(1, 0).Select
Application.ScreenUpdating = True
End Sub
Um mal alles wieder auf Null zu setzen folgender Code, deshalb auch die Schreibweise Billd, um keine anderen "Bild"er zu löschen.
Sub Löschen()
Dim B As Shape, n As Integer
For Each B In ActiveSheet.Shapes
If B.Name Like "\*Billd\*" Then B.Delete
Next B
For n = 1 To 1000
Namen(n) = ""
Next n
End Sub
Gruß
Reinhard