Hallo , hallo!
Möchte gern Bilder eines Ordners in eine Excel Tabelle einlesen lassen. Die Bilder sind bereits alle gleich groß (verkleinert-außer wenn sich Höhe und Breite aufgrund der Aufnahme vertauschen gibt es unterschiede)
Habe versucht eine Lösung im Netz zu finden, ist jedoch nach mehrfachen Versuchen nicht geglückt bzw. war für mich alles nicht umsetzbar!
Für Hilfe wäre ich Euch sehr sehr dankbar!
lg lenky
Hallo, guten Morgen Lenky,
es ist nicht möglich Bilder in Zellen zu stellen.
mit folgenden Codeschnippsel kannst du (hier eines der Beispielbilder) nach Excel holen:
ActiveSheet.Pictures.Insert("C:\Users\Public\Pictures\Sample Pictures\koala.jpg").Select
Ich habe ein wenig recherchiert und folgendes gefunden:
http://www.herber.de/forum/archiv/152to156/t154523.htm (http://www.herber.de/forum/archiv/152to156/t154523.htm)
Vielleicht hilft dir das weiter
Tag an ALLE!
Mit dem Link konnte ich leider nichts anfangen. Gibt es vielleicht eine Möglichkeit dies mit dem Makrorecorder zu erledigen?
Ich weiß, dass ich das Einfügen aufnehmen kann, kann dieser Code nicht irgendwie verändert werden, dass alle weiteren Bilder in den darunterliegenden Zellen eingefügt werden ?
Sub Makro4()
'
' Makro4 Makro
' Foto einlesen
'
'
End Sub ?????
Na gut, ich fang halt mal per "Hand" an.
lg have a nice day
lenky
Hallo Lenky
nochmal....
Zitates ist nicht möglich Bilder in Zellen zu stellen
Wenn ich's richtig interpretiere, dann leistet der Code am Ende der verlinkten Seite in meiner vorigen Antwort folgendces:
Es werden alle Bilder aus einem bestimmten Verzeichnis in ein Excelsheet eingefügt.
Leicht abgeändert, holt das Makro alle Bilder aus deinem Verzeichnis ins Excelsheet - die Bilder liegen danach alle übereinander!
Rufe Makro aufzeichnen auf, beende das gleich wieder, rufe Makro bearbeiten auf und kopiere dann den untenstehenden Code an die Stelle der abgebrochenen Aufzeichnung, dann ausführen....
Sub BilderEinfuegen()
Dim Höhe As Integer
Dim SHöhe As Single
Dim Breite As Integer
Dim SBreite As Integer
Dim Wert1
Dim J As Integer
Höhe = 17
Breite = 5
SBreite = 1
SHöhe = 2
Dim strVerzeichnis$, strDatei$
Dim pct As Picture
strVerzeichnis = "E:\DeinBilderVerzeichnis\"
strDatei = Dir(strVerzeichnis & "\*.jpg") 'liest alle *.jpg - Dateien aus
Cells(SHöhe, SBreite).Select
Cells(SHöhe - 1, SBreite) = strDatei ' schreibe Dateinamen
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei) ' einfügen Bild
MsgBox strDatei & " eingefügt!!", , "Bilder"
J = 2
Do While strDatei <> ""
strDatei = Dir()
If strDatei = "" Then Exit Do
Cells(SHöhe, SBreite).Select
Set pct = ActiveSheet.Pictures.Insert(strVerzeichnis & "\" & strDatei)
Cells(SHöhe - 1, SBreite) = strDatei
MsgBox strDatei & " eingefügt!!", , "Bilder"
J = J + 1
Loop
End Sub
hallo Peter!
Der Code klappt schon, aber dann muss ich aus einer Zelle alle Bilder per Hand verschieben! - natürlich eine Alternative, aber unübersichtlich.
Hab nochmal gesucht und Codes auf http://www.wintotal-forum.de/index.php/topic,82847.0.html gefunden. Der erste jedoch zeigt bei mir leider nur wie dort schon beschrieben die Icons der Bilder an, welche sich per Klick öffnen lassen.
- besteht da die Möglickeit das zu verändern? Die dort vorgeschlagene Änderung bringt nichts.
Der zweite Code funktioniert nicht, da ich nicht mächtig bin ihn zu debuggen. Ein Fehler With Application.FileSearch tritt auf.
Danke für Deine Mühe, oder die von Anderen!!!
lg lenky