Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
556to560
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
556to560
556to560
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Bilddatein per Schleife zeigen

Bilddatein per Schleife zeigen
28.01.2005 16:35:50
Karli
Ich möchte gerne per Button einen Ordner öffnen , und die im Ordner befindlichen Bilder auf einer Excel Seite per Schleife nacheinander anzeigen lassen.
Danke und Grüssle

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bilddatein per Schleife zeigen
Ramses
Hallo
Das gehört alles in ein Modul.
Gestartet werden muss das Makro Excel_Slide_Show()
Viel Spass


Option Explicit
'by Ramses
'Deklaration für Folderdialog < Office XP
Public Type BROWSEINFO
     hOwner As Long
     pidlRoot As Long
     pszDisplayName As String
     lpszTitle As String
     ulFlags As Long
     lpfn As Long
     lParam As Long
     iImage As Long
End Type
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As LongByVal pszPath As StringAs Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
'Deklarataion für Wartezyklen
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Excel_Slide_Show()
'by Ramses
'Angezeigt werden Bilder mit dem Format
'jpg, bmp, gif
'Die Zeit zur Darstellung kann in A1 eingetragen werden
'Alternativ werden die Bilder alle 5 Sekunden gewechselt
Dim oldStatus As Variant, myPic As Object
Dim srchFolder As String, gefFile As String
Dim As Integer, totFiles As Integer, sleepTime As Integer
Dim noFile1 As Boolean, noFile2 As Boolean, noFile3 As Boolean
'SleepTime in Millisekunden = Wie lange das Bild angezeigt wird
sleepTime = 5000
srchFolder = GetDirectory("Wählen Sie den Ordner mit den Bildern aus")
If srchFolder = "" Then
    MsgBox "Kein Ordner gewählt", vbInformation + vbOKOnly, "Abbruch"
    Exit Sub
End If
'Application.ScreenUpdating = False
oldStatus = Application.DisplayStatusBar
With Application.FileSearch
    .LookIn = srchFolder
    .SearchSubFolders = False
    .Filename = "*.bmp"
    If .Execute() > 0 Then
        totFiles = .FoundFiles.Count
        Application.StatusBar = "BMP Bild " & i & " von " & totFiles & " wird angezeigt"
        For i = 1 To .FoundFiles.Count
            gefFile = .FoundFiles(i)
            Set myPic = ActiveSheet.Pictures.Insert(gefFile)
            With myPic
                .TopLeftCell = Range("b5")
            End With
            If Range("A1") = "" Then
                '5 Sekunden warten
                Sleep sleepTime
            Else
                Application.Wait Now + TimeSerial(0, 0, Range("A1"))
            End If
            myPic.Delete
        Next i
    Else
        noFile1 = True
    End If
End With
With Application.FileSearch
    .LookIn = srchFolder
    .SearchSubFolders = False
    .Filename = "*.gif"
    If .Execute() > 0 Then
        totFiles = .FoundFiles.Count
        Application.StatusBar = "GIF Bild" & i & " von " & totFiles & " wird angezeigt"
        For i = 1 To .FoundFiles.Count
            gefFile = .FoundFiles(i)
            Set myPic = ActiveSheet.Pictures.Insert(gefFile)
            With myPic
                .TopLeftCell = Range("b5")
            End With
            If Range("A1") = "" Then
                '5 Sekunden warten
                Sleep sleepTime
            Else
                Application.Wait Now + TimeSerial(0, 0, Range("A1"))
            End If
            myPic.Delete
        Next i
    Else
        noFile2 = True
    End If
End With
With Application.FileSearch
    .LookIn = srchFolder
    .SearchSubFolders = False
    .Filename = "*.jpg"
    If .Execute() > 0 Then
        totFiles = .FoundFiles.Count
        Application.StatusBar = "Bild " & i & " von " & totFiles & " wird angezeigt"
        For i = 1 To .FoundFiles.Count
            gefFile = .FoundFiles(i)
            Set myPic = ActiveSheet.Pictures.Insert(gefFile)
            With myPic
                .TopLeftCell = Range("b5")
            End With
            If Range("A1") = "" Then
                Sleep sleepTime
            Else
                Application.Wait Now + TimeSerial(0, 0, Range("A1"))
            End If
            myPic.Delete
        Next i
    Else
        noFile3 = True
    End If
End With
If noFile1 = True And noFile2 = True And noFile3 = True Then
    MsgBox "Keine Bilder zum anzeigen gefunden", vbInformation + vbOKOnly, "Sorry,..."
Else
    MsgBox "Keine weiteren Bilder zum anzeigen gefunden", vbInformation + vbOKOnly, "Slide Show Ende"
End If
Application.StatusBar = oldStatus
Application.DisplayStatusBar = True
Application.ScreenUpdating = True
End Sub
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige