Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1840to1844
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

ListBox klick Bild Einfügen

ListBox klick Bild Einfügen
08.08.2021 13:19:11
oraculix
Hallöchen
In der Userform1 befindet sich eine Listbox und eine Anzeige für Bilder.
Ich hätte gerne bei Linksklick in die ListBox (nur Spalte B)das mir ein Bild eingefügt wird aus dem Verzeichnis "D:\EMDB\HTML\ExcelCovers\"
Wäre nett wenn ein Profi mir mit einem VBA Code helfen könnte.
Danke
https://www.herber.de/bbs/user/147505.xlsm
Gruß
Oraculix

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ListBox klick Bild Einfügen
08.08.2021 13:38:49
Nepumuk
Hallo,
teste mal:

Option Explicit
Private Sub Lst_Treffer_Click()
Const FOLDER_PATH As String = "D:\EMDB\HTML\ExcelCovers\"
Dim strFilename As String
strFilename = Dir$(PathName:=FOLDER_PATH & Lst_Treffer.List(Lst_Treffer.ListIndex, 1) & ".*")
If strFilename  vbNullString Then
Set Image1.Picture = LoadPicture(Filename:=FOLDER_PATH & strFilename)
Else
Set Image1.Picture = Nothing
End If
End Sub
Private Sub UserForm_Initialize()
StartUpPosition = 0 'manual
Top = 0
Left = 0
'Listbox Treffer Spalten einstellen
With Lst_Treffer
.ColumnCount = 3
.ColumnWidths = "7cm;8cm;2cm"
End With
Call Lst_Treffer_befüllen
End Sub
Private Sub Lst_Treffer_befüllen(Optional ByVal Ftext As String = vbNullString)
'Befüllung der LST_Treffer Listbox
Dim i As Long
Call Lst_Treffer.Clear
With Worksheets("FilmDB")
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Ftext = vbNullString Or InStr(1, .Cells(i, 1) & _
.Cells(i, 2) & .Cells(i, 8), Ftext, vbTextCompare) Then
Lst_Treffer.AddItem .Cells(i, 1).Text
Lst_Treffer.List(Lst_Treffer.ListCount - 1, 1) = .Cells(i, 2).Text
Lst_Treffer.List(Lst_Treffer.ListCount - 1, 2) = .Cells(i, 8).Text
End If
Next
End With
End Sub
Gruß
Nepumuk
Anzeige
AW: Super Danke !!!
08.08.2021 14:03:38
oraculix
Super Danke !!!
Jetz habe ich überall Covers Genial!!!!
Gruß
Oraculix
Ps: Warte auf weitere wünsche

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige