---

MehrereBilderinZellenfügen.jpg

Hallo zusammen,

ich hätte eine Frage wie kann ich mehrere Bilder aus einem Ordner in Zellen einfügen. Die größe der Bilder würde ich mit Zellenhöhe und breite regeln

Vielen, vielen dank im voraus für eure Hilfe.

UGMANX

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

ich empfehle mal den und den als Sekundärliteratur (Suchfunktion  ). Vielleicht ist da ja schon was Brauchbares dabei?

------------------
Gruß,
Frederik

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Fredrik,

vielen dank für die den Tipp.

Leider entspricht nicht das was ich mir vorgestellt habe.

Die Bilder mussen in eine Zelle.

Danke nochmals

UGMANX

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

   

Zitat:

---

Original erstellt von UGMANX:
wie kann ich mehrere Bilder aus einem Ordner in Zellen einfügen.

---

Da ich aus deiner Frage nicht mehr Informationen herauslesen kann -würde ich jetzt einfach halber sagen per hand...

Wenn die Aufgabenstellung ein wenig deutlicher formuliert ist:
- Ich möchte alle Bilder aus einem auswählbarem Verzeichnis nach Excel einbinden, ein Bild in jede Zelle, mit darüberliegender Zelle - die Beschreibung des eingebundenen Bildes....aufgeteilt auf einer 4 Spaltenmatrix...

mit Vba, <Ordner auswählen und Schleife> ;-)

- dann wäre die Aufgabenstellung ein wenig klarer und man würde nicht grübelt vor dem Thread sitzen und grübeln ;-) und womöglich einen Beitrag für die Tonne liefern   

habe mal diversen code aus dem Forum zusammengeschnippelt,
nun bist du dran

Code:

---

Sub Bilder()
    Dim NameZiel As Variant, Nr As Integer, shpRectangle As Shape
   
    ChDir "C:\Dokumente und Einstellungen\Thomas\Eigene Dateien\Eigene Bilder\" 'Pfadvorgeben
   
    NameZiel = Application.GetOpenFilename("Jpg (*.jpg),*.jpg," & _
    "Png -Bilder (*.png),*.png," & _
    "BMP (*.bmp),*.bmp", , "Bild-Dateien für Dokumentation auswählen!", MultiSelect:=True)
   
    If TypeName(NameZiel) = "Boolean" Then
        Beep
        MsgBox "Sie müssen min. eine Datei auswählen!"
        Exit Sub
    End If
    'sortierroutine
    For i = LBound(NameZiel) To UBound(NameZiel)
        For J = (i + 1) To UBound(NameZiel)
            If NameZiel(i) > NameZiel(J) Then
                Rem MsgBox Nums(i)
                tmp = NameZiel(i)
                NameZiel(i) = NameZiel(J)
                NameZiel(J) = tmp
            End If
        Next J
    Next i
    'einfüge Bilder in Zellen
    For Nr = LBound(NameZiel) To UBound(NameZiel)
    'MsgBox "ausgewählte Dateien" & (NameZiel(Nr))
    'ab hier, da war ich rüben klauen :-)
        With Range(Cells(Nr, 3), Cells(Nr, 3))
            Set shpRectangle = ActiveSheet.Shapes.AddShape( _
            msoShapeRectangle, .Left, .Top, .Width, .Height)
        End With
        shpRectangle.OLEFormat.Object.ShapeRange.Fill.UserPicture NameZiel(Nr)
    Next Nr
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP