Bilder in Excel einfügen - Stapelverarbeitung?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Sascha!
Du schreibst nicht wie und wo die Bilder eingefügt werden sollen!
Probier mal das!
Option Explicit

Sub BilderEinfuegen()
    'by J.Ehrensberger

    Dim fSearch As FileSearch
    Dim strPath As String
    Dim iCnt As Integer
    Dim pic As Picture

    On Error GoTo ERRORHANDLER
    Application.ScreenUpdating = False

    ' "alte" Bilder löschen
    ActiveSheet.Pictures.Delete

    'Pfad anpassen
    strPath = "C:\Dokumente und Einstellungen\Admin\Eigene Dateien\Eigene Bilder\" ' <-- Pfad zu den Bildern!

    Set fSearch = Application.FileSearch

    With fSearch
        .NewSearch
        .LookIn = strPath
        .SearchSubFolders = False '<<<<Unterordner durchsuchen True/False
        .FileType = msoFileTypeAllFiles
        .Filename = "*.jpg" '<<<<Dateiendung
        .Execute

        If .Execute() > 0 Then

            'gefundene Dateien durchlaufen
            For iCnt = 1 To .FoundFiles.Count
                'Bild einfügen
                Set pic = ActiveSheet.Pictures.Insert(.FoundFiles(iCnt))
                'Größe anpassen und ausrichten
                With pic.ShapeRange
                    .LockAspectRatio = msoTrue
                    .Left = Cells(iCnt, 1).Left
                    .Height = Cells(iCnt, 1).Height
                    .Top = Cells(iCnt, 1).Top
                End With
                Cells(iCnt, 2) = .FoundFiles(iCnt)
                Set pic = Nothing

            Next

        End If

    End With

    Set fSearch = Nothing

    ERRORHANDLER:
    Application.ScreenUpdating = True
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!

Hallo Sascha!
Wenn du den Pfad zu deinem Bilderordner richtig angibst, dann sollte das funzen!
Sub BilderEinfuegen()
    'by J.Ehrensberger

    Dim fSearch As FileSearch
    Dim strPath As String
    Dim iCnt As Long
    Dim lRow As Long
    Dim pic As Picture
    Dim picHeight As Single

    On Error GoTo ERRORHANDLER
    Application.ScreenUpdating = False

    ' "alte" Bilder löschen
    ActiveSheet.Pictures.Delete

    ' "alte" Bildnamen löschen
    Range("A:A").ClearContents

    ' Bildhöhe <<<--- Gewünschte Höhe der Bilder - Anpassen!!!
    picHeight = 45

    ' Startzeile <<<--- Anpassen!!!
    lRow = 1

    ' Pfad <<<--- Anpassen
    strPath = "C:\Dokumente und Einstellungen\Admin\Eigene Dateien\Eigene Bilder\" ' <-- Pfad zu den Bildern!

    Set fSearch = Application.FileSearch

    With fSearch
        .NewSearch
        .LookIn = strPath
        .SearchSubFolders = True '<<<<Unterordner durchsuchen True/False - Anpassen!!!
        .FileType = msoFileTypeAllFiles
        .Filename = "*.jpg" '<<<<Dateiendung !!!


        If .Execute() > 0 Then

            'gefundene Dateien durchlaufen
            For iCnt = 1 To .FoundFiles.Count
                'Bild einfügen
                Set pic = ActiveSheet.Pictures.Insert(.FoundFiles(iCnt))
                'Größe anpassen und ausrichten
                With pic.ShapeRange
                    .LockAspectRatio = msoTrue
                    .Height = picHeight
                    .Left = Cells(lRow, 1).Left
                    .Top = Cells(lRow, 1).Top
                End With

                Cells(lRow, 1).RowHeight = picHeight

                ' Bildname mit Pfad
                Cells(lRow + 1, 1) = .FoundFiles(iCnt)
                ' oder nur Bildname
                'Cells(lRow + 1, 1) = Right(.FoundFiles(iCnt), InStr(1, StrReverse(.FoundFiles(iCnt)), "\") - 1)

                lRow = lRow + 2

                Set pic = Nothing

            Next

        End If

    End With

    Set fSearch = Nothing

    ERRORHANDLER:
    Application.ScreenUpdating = True
End Sub

Gruß Sepp
P.S.: Rückmeldung nicht vergessen!

Beliebteste Forumthreads (12 Monate)

Bilder in Excel einfügen - Stapelverarbeitung?

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread