Bilder anzeigen

Hallo Excel-Profi's,
ich würde gerne Bilder von Gruppenmitgliedern (GM) bei Zellaktivierung (E5 bis E35 - sind leere Zellen) anzeigen lassen.
Die Namen der GM stehen im Bereich C5:C35, die Vornamen im Bereich D5:D35.
Die Bilder sind im jpg-Format unter Images im gleichen Verzeichnis/Ordner wie das Programm gespeichert
(H:\Programme\Gruppe; bzw. H:\Programme\Images)
Die Bezeichnung der Bilder ist z.B. Mustermann Max.jpg
Die Beiträge im Forum habe ich mir angesehen, einige Beispiele auch versucht umzusetzen - was jedoch kläglich scheiterte. Ich hoffe mein Anliegen ist nicht zu nervig für euch und ihr könnt mir mit euerem Fachwissen helfen.
Im voraus schon vielen Dank für euere Bemühungen.
PS: Da diese Anfrage von meinem Arbeitsplatz gestartet wurde, kann sich eine Rückmeldung von mir evtl. verzögern da ich im Schichtdienst arbeite.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim objPicture As Picture If Target.Count > 1 Then Exit Sub On Error GoTo Fin If Not Intersect(Target, Range("E5:E35")) Is Nothing Then If Dir(ThisWorkbook.Path & "\" & Target.Offset(0, -2) & ".jpg") "" Then With Cells(Target.Row, Target.Column).Offset(0, 1) Pictures.Delete Set objPicture = .Parent.Pictures.Insert _ (ThisWorkbook.Path & "\" & Target.Offset(0, -2) & ".jpg") objPicture.Top = .Top objPicture.Left = .Left objPicture.Height = 50 objPicture.Width = 50 End With Else Pictures.Delete End If Else Pictures.Delete End If Fin: Set objPicture = Nothing If Err.Number 0 Then MsgBox "Error: " & _ Err.Number & " " & Err.Description End Sub

Hallo,
ich hätte da eine Doppelklicklösung. Die Pfadangaben und die Dateinamen der Bilder
wären noch anzupassen auf Deine Bedingungen!!

'Dateinamen der Passbilder (ohne die Erweiterung '.jpg') stehen in Spalte 2
'Der Doppelklick auf einen Namen in Spalte 2 zeigt das Passbild an
'Ein Doppelklick in jeder anderen Spalte löscht die Bildanzeige
'In diesem Beispiel befinden sich die Bilder zusammen mit
'der Arbeitsmappe in einem gemeinsamen Ordner, daher so: ThisWorkbook.Path & "\" & vJPEG
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim vJPEG As String
Dim i As Long
On Error GoTo fehler
With ActiveSheet
If .Pictures.Count > 0 Then
.Pictures.Delete
End If
If Target.Column = 2 Then
vJPEG = Cells(Target.Row, Target.Column).Value & ".JPG"
.Pictures.Insert(ThisWorkbook.Path & "\" & vJPEG).Select
With Selection
.ShapeRange.ScaleWidth 2.5, msoFalse, msoScaleFromTopLeft
.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft
End With
End Select
End With
Exit Sub
fehler:
MsgBox "Kein Bild verfügbar!"
End Sub

Gruß
Jochen

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread