Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1784to1788
1784to1788
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

In Masse Bilder importieren

Forumthread: In Masse Bilder importieren

In Masse Bilder importieren
28.09.2020 15:57:46
Dennis
Hallo zusammen,
besteht irgendwie eine Möglichkeit, habe den Dateipfad in einer Zelle stehen, die Bilder automatisch (wenn möglich) in Masse zu importieren?
Anzeige

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: In Masse Bilder importieren
28.09.2020 16:25:34
Nepumuk
Hallo Dennis,
was soll ich mir unter "Masse" vorstellen?
Gruß
Nepumuk
AW: In Masse Bilder importieren
28.09.2020 19:52:28
Dennis
Es handelt sich um ca. 800 Zeilen also 800 Bilder aus einem Ordner
AW: In Masse Bilder importieren
28.09.2020 20:30:10
Nepumuk
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
Anzeige
AW: In Masse Bilder importieren
28.09.2020 21:04:24
Dennis
Ab A2-A717 sind die Pfade der Bilder... Was muss ich da ändern?
AW: In Masse Bilder importieren
29.09.2020 09:56:10
Nepumuk
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
Anzeige
AW: In Masse Bilder importieren
29.09.2020 12:01:06
Dennis
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?
AW: In Masse Bilder importieren
29.09.2020 12:05:26
Nepumuk
Hallo Dennis,
steht in den Zellen nur der Dateiname des Bildes inklusive Endung?
Gruß
Nepumuk
Anzeige
AW: In Masse Bilder importieren
29.09.2020 12:31:49
Dennis
Ja genau
AW: In Masse Bilder importieren
29.09.2020 12:35:59
Nepumuk
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
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige