Supportnet / Forum / Tabellenkalkulation
Bild in eine Exceldatei einbinden
Frage
Hallo zusammen!
Ich steh vor einem kleinen Problem.
Ich habe eine kleine Datenbank und in dieser
würde ich gerne verschiedene
Bilder einer bestimmten Zahl zuordnen.
Z.b.
Bei A1 wird der Wert "1" eingegeben -> daher sollte bei A2
das Bild "Bild_1" erscheinen.... Wenn der Wert "2" ist, sollte
das "Bild Bild_2" erscheinen.... Insgesamt benötige ich 6
Bilder zur Auswahl. Kann ich so etwas über Makro steuern?
Wäre echt toll, wenn ihr mir eine Anregeung geben könntet.
Danke
Antwort 1 von Hajo_Zi
Antwort 2 von nighty
hi all :-)
hier noch eine variante vor kurzen erst reingestellt
pfad wie endung der bilddateien waeren anzupassen
gruss nighty
einzufuegen alt f11/projektexplorer/DeineTabelle
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 3 Then
On Error GoTo fehler
Dim Bpfad As String
Dim Bbild As String
Dim mywidth As Long
Dim myheight As Long
Bbild = ".jpg"
Bpfad = "D:\Briefe\micha\jpg\"
With Application.FileSearch
.NewSearch
.LookIn = Bpfad
.SearchSubFolders = False
.Filename = Cells(Target.Row, Target.Column) & Bbild
If .Execute() > 0 Then
ActiveSheet.Pictures.Insert(Bpfad & Cells(Target.Row, Target.Column) & Bbild).Select
mywidth = Selection.Width
myheight = Selection.Height
Selection.Delete
Cells(Target.Row, Target.Column).AddComment
Application.DisplayCommentIndicator = xlCommentAndIndicator
Cells(Target.Row, Target.Column).Comment.Shape.Select True
With Selection.ShapeRange
.Width = mywidth
.Height = myheight
End With
Selection.ShapeRange.Fill.UserPicture Bpfad & Cells(Target.Row, Target.Column) & Bbild
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
Cells(Target.Row, Target.Column).Comment.Visible = False
End If
End With
End If
Application.EnableEvents = True
End
fehler:
If Err = 1004 Then Resume Next
Application.EnableEvents = True
End Sub
hier noch eine variante vor kurzen erst reingestellt
pfad wie endung der bilddateien waeren anzupassen
gruss nighty
einzufuegen alt f11/projektexplorer/DeineTabelle
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column = 3 Then
On Error GoTo fehler
Dim Bpfad As String
Dim Bbild As String
Dim mywidth As Long
Dim myheight As Long
Bbild = ".jpg"
Bpfad = "D:\Briefe\micha\jpg\"
With Application.FileSearch
.NewSearch
.LookIn = Bpfad
.SearchSubFolders = False
.Filename = Cells(Target.Row, Target.Column) & Bbild
If .Execute() > 0 Then
ActiveSheet.Pictures.Insert(Bpfad & Cells(Target.Row, Target.Column) & Bbild).Select
mywidth = Selection.Width
myheight = Selection.Height
Selection.Delete
Cells(Target.Row, Target.Column).AddComment
Application.DisplayCommentIndicator = xlCommentAndIndicator
Cells(Target.Row, Target.Column).Comment.Shape.Select True
With Selection.ShapeRange
.Width = mywidth
.Height = myheight
End With
Selection.ShapeRange.Fill.UserPicture Bpfad & Cells(Target.Row, Target.Column) & Bbild
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
Cells(Target.Row, Target.Column).Comment.Visible = False
End If
End With
End If
Application.EnableEvents = True
End
fehler:
If Err = 1004 Then Resume Next
Application.EnableEvents = True
End Sub
Antwort 3 von nighty
hi all :-)
ein automatismus fuer beliebig viele bilder,namen sind in einer beliebigen zelle eingebbar mit darstellung des bildes im kommentarfeld der zelle
gruss nighty
ein automatismus fuer beliebig viele bilder,namen sind in einer beliebigen zelle eingebbar mit darstellung des bildes im kommentarfeld der zelle
gruss nighty
Antwort 4 von WolfgangN
nochmals
ein DANKE
super
ein DANKE
super