Gruppen
- Top Gruppen
- Betriebsysteme
- Windows classik
- Linux
- BS-Sonstige
- Software
- Datenbanken
- Bildbearbeitung
- Audio/mp3/Video
- Security/Viren
- SW-Sonstige
- Hardware
- Mainboard/CPU
- Grafikkarten
- Peripherie
- Laptop/Notebook
- HW-Sonstiges
- Netzwerk
- Telefon,ISDN,Modem
- W-Lan
- NW-Sonstiges
- Programmierung
- PHP,ASP,Perl...
- Java,C++...
- Webseiten/HTML
- Sonstiges
- PC-Sonstiges
- Plauderecke
- SN Intern
- Test
/ Forum / Tabellenkalkulation
Tabellenkalkulation
Fragevon RPB vom 02.02.2019, 16:54 Options
Können Grafiken wie in Access auch in Excel gesucht und angezeigt werden
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
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 vom 03.02.2019, 12:37 Options
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
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 vom 03.02.2019, 12:41 Options
hi all :-)
endung jpg im code anzupassen bei dir eben tiff
gruss nighty
endung jpg im code anzupassen bei dir eben tiff
gruss nighty
Antwort 3 von nighty vom 03.02.2019, 12:47 Options
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
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 vom 03.02.2019, 14:43 Options
Hi Nighty,
kannst Du mir eine Beispieltabelle zusenden auf
mfg
Ralf
ralf-peter@dr-buenning.de
kannst Du mir eine Beispieltabelle zusenden auf
mfg
Ralf
ralf-peter@dr-buenning.de
Antwort 5 von nighty vom 05.02.2019, 10:22 Options
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
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
Ähnliche Themen
Excel Abfrage mit Verknüpfung von Daten aus 2 Mappen
willymo 29.10.2007 - 336 Hits - 6 Antworten
Problem mit word, excel ,access ( 2002 )
senator 29.10.2007 - 148 Hits - 1 Antwort
Grafiken platzieren
Bollerkohl 07.02.2008 - 55 Hits - 1 Antwort
VBA-Excel
mentosbasi 28.05.2008 - 350 Hits - 3 Antworten
Hinweis
Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..
Neue Einträge
