Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Können Grafiken wie in Access auch in Excel gesucht und angezeigt werden





Frage

Eine Frage an alle Profis, mit dem Befehl Sverweis() kann ich bestimmte Werte aus Spalten auslesen. Ist es auch möglich zu diesen Werten (z.B. Bauteilenummern) die dazugehörige Grafik zu laden, die sich in einem Verzeichnis im Explorer befindet. Ich habe eine Eingabemaske entwickelt die verschiedene Parameter zu einem Bauteil anzeigt nur leider nicht die dazugehörige Grafik. (z.B. Wenn ich mir zum Bauteil Nr. 0815 alle technischen Daten anzeigen lasse dann soll auch Grafik 0815.tiff geladen werden.) Viel Spaß Mein Dank wird unermesslich sein RPB

Antwort 1 von nighty

hi all :)

hier ein beispiel

eine geänderte zelle in spalte c bekommt ein neues kommentarfeld worin das bild dargestellt wird ,mit dem bildnamen der geänderten zelle und der zugefuegten endung jpg

gruss nighty

on error resume next ist allenfalls nur eine notlösung da wenig zeit jetzt hab

einzufügen unter

alt/f11/projektexplorer/DeineTabelle

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Rem 3=spalte c
If Target.Column = 3 Then
On Error Resume Next
Dim Bpfad As String
Dim mywidth As Long
Dim myheight As Long
Rem DeinenPfadAnpassen
Bpfad = "D:\Briefe\micha\jpg\"
With Application.FileSearch
.NewSearch
.LookIn = Bpfad
.SearchSubFolders = True
.Filename = Cells(Target.Row, Target.Column) & ".jpg"
If .Execute() > 0 Then
ActiveSheet.Pictures.Insert(Bpfad & Cells(Target.Row, Target.Column) & ".jpg").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) & ".jpg"
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
Cells(Target.Row, Target.Column).Comment.Visible = False
End If
End With
End If
Application.EnableEvents = True
End Sub

Antwort 2 von nighty

hi all :-)

endung jpg im code anzupassen bei dir eben tiff

gruss nighty

Antwort 3 von nighty

hi all :-)

es ist natuerlich auch möglich das gesammte laufwerk mit unterverzeichnissen durchsuchen zu lassen was aber zulange in manchen fällen dauert daher ist eine pfadangaben sinnvoller

gruss nighty

Antwort 4 von RPB

Hi Nighty,

kannst Du mir eine Beispieltabelle zusenden auf

mfg

Ralf

ralf-peter@dr-buenning.de

Antwort 5 von nighty

hi all :-)

die korrigierte variante

gruss nighty

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

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: