Bilder aus einem Ordner auslesen

Hallo zusammen,
Bin neu hier und habe mal eine Frage an die
Profis über VBA
Folgendes Problem.
Besteht die möglichkeit das wenn ich einen Commandbutton drücke (oder beim öffnen der Tabelle) das eine Userform oder soetwas ähnliches aufgeht wo ich dann den Ordner aussuchen kann sprich der Pfad variiert und das anschliessend der Ordnerinhalt sprich Bilder .JPG ausgelesen werden .Die sollten dann zb ab B4 das erste Bild das zweite dann B5 usw. usw eingefügt werden bis alle Bilder geladen sind sprich das die Bilder in der Tabelle alle gleich gross ca.5x5 cm sind und das sich die Zeile dementsprechend anpasst von der grösse .Wenn das schon ginge wäre super.
Dann noch eine Zusatzfrage:
Besteht weiterhin die möglichkeit das automatisch (nicht erst jedem Bild ein Makro zuordnen muss) wenn ich ein Bild anklicke das es etwas grösser wird wie zb. bei Bild bei Klick
Dieses ist bestimmt nicht so einfach zu lösen da ich die letzten zwei Tage schon wie zum Teufel gesucht habe .Habe zwar so ein paar Ansätze gefunden aber da mein VBA nicht so gut ist hoffe ich das ihr mir helfen könnt

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo
Hier mal ein Tipp wie ich das gemacht habe
In einem Sheet (Worksheets("BildDatei"))
habe ich den Dateinamen mit Ordner gelistet
A B
1 D:\TEMP\
2 DSC_0097.JPG D:\TEMP\DSC_0097.JPG
im activen Arbeitsblatt alle Bilder geöffnet und die Größe angepasst
vielleicht hilt Dir das weiter
anbei das kleine script
gruß wolfgang

Sub BilderDrucken()
Dim k, n As Variant
Dim b As Object
Dim Datei1, Datei2, Datei3 As String
Set b = Worksheets("BildDatei")
k = 2
On Error Resume Next
For i = 2 To b.Cells(65536, 2).End(xlUp).Row
Datei1 = b.Cells(i, 2)
Datei2 = b.Cells(i + 1, 2)
Datei3 = b.Cells(i + 2, 2)
ActiveSheet.Cells(k, 1).Select
With ActiveSheet.Pictures
'.Delete
.Insert(Datei1).Select
With Selection.ShapeRange
.LockAspectRatio = msoTrue
.Height = 90
End With
End With
ActiveCell.Offset(7, 0) = Right(Datei1, 12)
ActiveSheet.Cells(k, 2).Select
With ActiveSheet.Pictures
.Insert(Datei2).Select
With Selection.ShapeRange
.LockAspectRatio = msoTrue
.Height = 90
End With
End With
ActiveCell.Offset(7, 0) = Right(Datei2, 12)
ActiveSheet.Cells(k, 3).Select
With ActiveSheet.Pictures
.Insert(Datei3).Select
With Selection.ShapeRange
.LockAspectRatio = msoTrue
.Height = 90
End With
End With
ActiveCell.Offset(7, 0) = Right(Datei3, 12)
ActiveCell.Offset(8, -2).Select
k = ActiveCell.Row
i = i + 2
Next i
End Sub

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bilder aus einem Ordner auslesen

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread