Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Zufallsbild in Userform laden

Zufallsbild in Userform laden
05.01.2005 20:01:06
Claus
Hallo Leute,
ich habe das Problemchen, das ich nichtmal ansatzweise weiß, wie ich in eine Userform ein gif-Bild aus einem definierten Ordner lade. Die Bilder sollen zufällig gewählt werden und auf die Größe Width 420 Heigh 130 angepaßt werden...
Kann mir da jemand auf die Sprünge helfen?
Vielen Dank, Claus

Sub Bilder_Files()
Dim Datei As String
Dim Pfad As String
Pfad = "C:\export\"
Datei = Dir(Pfad & "*.gif")
End Sub

Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zufallsbild in Userform laden
05.01.2005 20:44:25
Matthias
Hallo Ransi,
aha, mit "FileSearch" geht das... wieder was gelernt ;-)
Gruß Matthias
Anzeige
@ matthias
ransi
hallo matthias
mit dir() gehts auch.
...aber nicht so komfortabel.
gruß ransi
AW: Zufallsbild in Userform laden
05.01.2005 20:38:22
Matthias
Hallo Claus,
es ist glaub ich nicht das eleganteste, aber er funktioniert ;-)
Private Sub CommandButton1_Click()
Dim d As String
d = Zufallsdatei("C:\export\", "gif")
Image1.Picture = LoadPicture(d)
End Sub
und dann noch die Funktion:
Function Zufallsdatei(pfad As String, typ As String) As String
Dim i As Integer, j As Integer
Dim pic As String
'Anzahl passender Dateien zählen
i = 0
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
pic = Dir(pfad & "*." & typ)
Do While pic <> ""
i = i + 1
pic = Dir()
Loop
'Zufallszahl zwischen 1 bis i erzeugen
Randomize
i = Int(Rnd() * i) + 1
' i-tes Bild laden
pic = Dir(pfad & "*." & typ)
For j = 2 To i
pic = Dir()
Next j
If pic <> "" Then
Zufallsdatei = pfad & pic
Else
Zufallsdatei = ""
End If
End Function
Die Breite und Höhe kannst du ja schon im Eigenschaftenfesnter des Images festlegen, außerdem den PictureSizeMode auf Stretch.
Grüße,
Matthias
Anzeige
Super...Danke!
05.01.2005 20:46:57
Claus
Danke
FileSearch Zufall
ChrisL
Hi Claus
Habe zwischenzeitlich ebenfalls eine Funktion erstellt.
Sub TestMakro()
MsgBox RndDatei("G:\", "gif")
End Sub

Private Function RndDatei(Verzeichnis As String, DateiTyp As String) As String
Dim iCount As Long
Dim FS As FileSearch
If Left(DateiTyp, 2) <> "*." Then DateiTyp = "*." & DateiTyp
Set FS = Application.FileSearch
With FS
.NewSearch
.LookIn = Verzeichnis
.SearchSubFolders = False
.Filename = DateiTyp
.FileType = msoFileTypeAllFiles
.LastModified = msoLastModifiedAnyTime
.Execute
If .FoundFiles.Count > 0 Then
RndDatei = .FoundFiles.Item(Int((.FoundFiles.Count) * Rnd + 1))
End If
End With
End Function

Gruss
Chris
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige