In Masse Bilder importieren

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

In Masse Bilder importieren

In Masse Bilder importieren von Dennis vom 28.09.2020 15:57:46

AW: In Masse Bilder importieren - von Nepumuk am 28.09.2020 16:25:34
- AW: In Masse Bilder importieren - von Dennis am 28.09.2020 19:52:28
  - AW: In Masse Bilder importieren - von Nepumuk am 28.09.2020 20:30:10
    - AW: In Masse Bilder importieren - von Dennis am 28.09.2020 21:04:24
      - AW: In Masse Bilder importieren - von Nepumuk am 29.09.2020 09:56:10
        
        AW: In Masse Bilder importieren - von Dennis am 29.09.2020 12:01:06
        
        AW: In Masse Bilder importieren - von Nepumuk am 29.09.2020 12:05:26
        
        AW: In Masse Bilder importieren - von Dennis am 29.09.2020 12:31:49
        
        AW: In Masse Bilder importieren - von Nepumuk am 29.09.2020 12:35:59

Betrifft: In Masse Bilder importieren von: Dennis
Geschrieben am: 28.09.2020 15:57:46

Hallo zusammen,

besteht irgendwie eine Möglichkeit, habe den Dateipfad in einer Zelle stehen, die Bilder automatisch (wenn möglich) in Masse zu importieren?

Betrifft: AW: In Masse Bilder importieren
von: Nepumuk
Geschrieben am: 28.09.2020 16:25:34

Hallo Dennis,

was soll ich mir unter "Masse" vorstellen?

Gruß
Nepumuk

Betrifft: AW: In Masse Bilder importieren
von: Dennis
Geschrieben am: 28.09.2020 19:52:28

Es handelt sich um ca. 800 Zeilen also 800 Bilder aus einem Ordner

Betrifft: AW: In Masse Bilder importieren
von: Nepumuk
Geschrieben am: 28.09.2020 20:30:10

Hallo Dennis,

ich bin jetzt mal davon ausgegangen dass sich der Ordnerpfad in Zelle A1 befindet und das alles .jpg - Bilder sind.

Option Explicit

Public Sub InsertPictures()

    Dim strPath As String, strFileName As String
    Dim sngTop As Single
    Dim objShape As Shape

    strPath = Cells(1, 1).Text
    If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

    strFileName = Dir$(strPath & "*.jpg")

    Do Until strFileName = vbNullString

        Set objShape = Tabelle1.Shapes.AddPicture(Filename:=strPath & strFileName, LinkToFile:=msoFalse, _
            SaveWithDocument:=msoTrue, Left:=0, Top:=sngTop, Width:=-1, Height:=-1)

        sngTop = sngTop + objShape.Height

        strFileName = Dir$

    Loop

    Set objShape = Nothing

End Sub

Gruß
Nepumuk

Betrifft: AW: In Masse Bilder importieren
von: Dennis
Geschrieben am: 28.09.2020 21:04:24

Ab A2-A717 sind die Pfade der Bilder... Was muss ich da ändern?

Betrifft: AW: In Masse Bilder importieren
von: Nepumuk
Geschrieben am: 29.09.2020 09:56:10

Hallo Dennis,

teste mal:

Option Explicit

Public Sub InsertPictures()

    Dim strPath As String, strFileName As String
    Dim lngRow As Long
    Dim objShape As Shape

    For lngRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row

        With Cells(lngRow, 1)

            If Dir$(.Text) <> vbNullString Then

                Set objShape = ActiveSheet.Shapes.AddPicture(Filename:=.Text, LinkToFile:=msoFalse, _
                    SaveWithDocument:=msoTrue, Left:=.Offset(0, 1).Left, Top:=.Top, Width:=-1, Height:=-1)

            Else

                .Offset(0, 1).Value = "Bild nicht gefunden"

            End If

        End With
    Next

    Set objShape = Nothing

End Sub

Gruß
Nepumuk

Betrifft: AW: In Masse Bilder importieren
von: Dennis
Geschrieben am: 29.09.2020 12:01:06

Hi Nepumuk,

vielen Dank erstmal für deine Hilfe.

Die Bilder liegen alle im gleichen Ordner wie das Excel-File, es wird mir aber immer "Bild nicht gefunden" ausgegeben. Hast du noch eine Idee??

Betrifft: AW: In Masse Bilder importieren
von: Nepumuk
Geschrieben am: 29.09.2020 12:05:26

Hallo Dennis,

steht in den Zellen nur der Dateiname des Bildes inklusive Endung?

Gruß
Nepumuk

Betrifft: AW: In Masse Bilder importieren
von: Dennis
Geschrieben am: 29.09.2020 12:31:49

Ja genau

Betrifft: AW: In Masse Bilder importieren
von: Nepumuk
Geschrieben am: 29.09.2020 12:35:59

Hallo Dennis,

dann so:

Option Explicit

Public Sub InsertPictures()

    Dim strPath As String, strFileName As String
    Dim lngRow As Long
    Dim objShape As Shape

    strPath = ThisWorkbook.Path & "\"

    For lngRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row

        With Cells(lngRow, 1)

            If Dir$(strPath & .Text) <> vbNullString Then

                Set objShape = ActiveSheet.Shapes.AddPicture(Filename:=strPath & .Text, LinkToFile:=msoFalse, _
                    SaveWithDocument:=msoTrue, Left:=.Offset(0, 1).Left, Top:=.Top, Width:=-1, Height:=-1)

            Else

                .Offset(0, 1).Value = "Bild nicht gefunden"

            End If

        End With
    Next

    Set objShape = Nothing

End Sub

Gruß
Nepumuk

Herbers Excel/VBA-Archiv

Der kurze Weg zum Ziel: Auftragsprogrammierung

In Masse Bilder importieren