Pfad für Bilderimport setzen
29.01.2025 13:14:44
Martin
Hallo zusammen
zu diesem Thema:
https://www.herber.de/forum/archiv/1996to2000/1999190_Pfad_fuer_Bilderimport_setzen.html
habe ich nun eine für mich gute Lösung gefunden.
Dies ist mein Makro, welches über einen Button aufgerufen wird:
Public Pfad As String
Public varDateiPfad As String
Public Einfügeort As String
Sub Bild_Feuerung_Kessel_manuell_ändern()
varDateiPfad = Worksheets("Daten").Range("O16") ' Pfad des Dossiers einlesen
Worksheets("HSL").Activate ' Tabellenblatt anwählen
Range("A45").Select ' Zelle setzen
Einfügeort = "A45:O47" ' Einfügeort für das Bild setzen
Pfad = varDateiPfad & "\Feuerung & Kessel\" ' Pfad auf den Ordner mit den Bildern setzen
Userform_Bme.Show
End Sub
Und hier meine Userform:
Option Explicit
Private Sub ListBox1_Click()
Image1.Picture = LoadPicture(Pfad & ListBox1.List(ListBox1.ListIndex) & ".jpg")
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
' Bild löschen
ActiveSheet.Unprotect Password:="Test"
Range(Einfügeort).Select
Selection.ClearContents
Selection.InsertPictureInCell (Pfad & ListBox1.List(ListBox1.ListIndex) & ".jpg")
Unload Me
ActiveSheet.Protect Password:="Test", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=False, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=False, _
AllowFiltering:=False, _
AllowUsingPivotTables:=False
End Sub
Private Sub UserForm_Initialize()
Dim AktDat As String
AktDat = Dir(Pfad & "*.jpg")
While AktDat > ""
ListBox1.AddItem Left(AktDat, Len(AktDat) - 4)
AktDat = Dir
Wend
ListBox1.Selected(0) = True
End Sub
Und so sieht dann das Ergebnis aus:
Links sind die Bilder im Ordner aufgeführt und rechts die Vorschau, die sich, je nachdem welches Bild angewählt wird ändert.
Mit Doppelklick auf den Text wird das bestehende Bild im Tabellenblatt gelöscht und das neue eingefügt
Gruss Martin