[Excel] Thumbnails automatisch in Excel einfügen

[tox4]

Hallo an alle Apfeltalk-Mitglieder,

Ich würde mir gerne eine Inventarliste in Excel erstellen, die sowohl einen Thumbnail als auch den originalen Dateinamen (Fotos) enthält. In weiterer Folge kommen dann Keywords, Ausrichtung des Fotos (Hochformat, Quer) usw. dazu. Die Thumbnails sind deswegen so wichtig damit ich einen visuellen Bezug zu dem Fotos habe (und dann die erste Spalte sperren kann)

Die Thumbnails liegen alle in einem speziellen Ordner (/Users/ericL/Desktop/PrintReady/Thumbnail) und sollen dann später in Zelle A1, A2, usw. eingefügt werden.
Wichtig ist das die Fotos dann in der Zelle zentriert eingebettet sind damit sie beim sortieren nicht verrutschen.

Ich habe schon verschiedene Codes aus diversen Foren ausgetestet, leider haben die nicht wirklich hingehauen (die dürften nur für Windows funktionieren). Manuell habe ich die Fotos auch schon eingefügt aber das war auch nicht wirklich erfolgreich.
Die Entwicklertools habe ich aktiviert und die Codes die ich in ein Modul eingefügt habe funktionierten auch nicht.

Mein Wissen für VBA ist unter dem Minimum, den Pfad kann ich ändern aber das wars auch schon. =) Sorry.
Vielleicht mach ich auch was anderes falsch.

Betriebssystem: Sierra 10.12.
Office 2016: Version 16.16

Gibt es überhaupt eine Lösung für dieses Problem?

Hier ein Code der nicht funktioniert:

Sub InsertPictures()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
xRowIndex = Application.ActiveCell.Row
For lLoop = LBound(PicList) To UBound(PicList)
Set Rng = Cells(xRowIndex, xColIndex)
Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
xRowIndex = xRowIndex + 1
Next
End If
End Sub


Danke schon im Vorhinein an alle die tatkräftig mitschreiben. LG

 

[Leraje]

Excel VBA unter macOS ist ein Graus, das habe ich nach 5 Minuten sein lassen. Es gibt sehr viele Bibliotheken nicht, von UserForms ganz zu schweigen.

Zu deinem eigentlichen Problem:

Zunächst müsstest du die Verfahrensweise definieren.

Trägst du den Dateinamen selber ein, und Excel soll dann anhand des Namens das Bild im Ordner finden und in die Zelle der jeweiligen Zeile schreiben?
Oder setzt du einfach die Bilder in den Ordner, und Excel soll automatisch schauen ob im Ordner Bilder sind, dann schauen ob sie schon in der Tabelle stehen, und wenn nicht Bild und Dateiname einfügen?

Beides wäre aber ohne mindestens Grundkenntnisse VBA fast nicht möglich

 

[tox4]

Hallo Leraje, ich habe mithilfe von TextEdit schon die Dateinamen in der Exceltabelle - die sind alphabetisch sortiert.

Ich würde zur Zeit Variante 2 bevorzugen, die Bilder sind im Ordner und Excel fügt mir die Thumbnails einzeln in A2, A3 usw. ein (A1 ist die Überschrift.

Die Bilder lassen sich auch nicht in das Kommentarfeld händisch hineinkopieren. Es wären 'nur' 170 Fotos.
Irgendeine Lösung muss es ja geben.

Das VBA und die kopierten Codes oft nicht funktionieren habe ich schon mitbekommen.
Hast du noch eine andere Idee?

Danke für deine Antwort. LG Eric

 

[Leraje]

Ich bin noch unterwegs und komme heute Abend dazu Dir einen Code zu schicken

 

[tox4]

Die Liste ist flexibel und wird in Zukunft erweitert. Kann das Skript dann auf die Zelle B2, B3 (auf den Dateinamen) schauen und dann das zugehörige Foto in A2,A3 einfügen?
Du weißt gar nicht wie mir das weiterhilft. Vielen Vielen Dank

 

[Leraje]

Im Bild das Makro.

einfach ein neues Modul einfügen, Text rein, und in der Tabelle eine Schaltfläche einfügen die das Makro aufruft. Bei mir läuft's

 

[tox4]

Hey Leraje, also erstmals vielen lieben Dank das du dir die Mühe machst das zu programmieren !!
Das Feld A2 sollte markiert sein?
Er tut leider nicht wirklich was. Entweder hab ich's falsch abgeschrieben (mehrmals kontrolliert) oder irgendwas ist noch falsch mit meinem Excel. Funktioniert der untere Code bei dir?
Er wirft mir den Fehlercode 1004 aus und schreibt mir: Die Insert Eigenschaft des Pictures Objektes kann nicht zugeordnet werden.

Sub Bildimport()
    Dim i As Integer
    Dim IngZeile As Long
    Dim rng As Range
    Dim Verzeichnis$, Bild$
    Dim Bereich As Range
    Dim pct As Picture

    Verzeichnis = "/Users/ericL/Desktop/PrintReady/Thumbnail/"

    IngZeile = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row
    Set Bereich = Range("B2:B" & IngZeile)

For Each rng In Bereich
    i = 2
    Range("A" & i).Select
    Set pct = Worksheets("Tabelle1").Pictures.Insert(Verzeichnis & Range("B" & i).Text)
    i = i + 1
Next rng


End Sub

 

[Leraje]

Das Verzeichnis für die Bilder stimmt, oder?

Der Code geht Zeile für Zeile durch und markiert in der jeweiligen Zeile die Zelle in Spalte am um das Bild einzufügen. Du brauchst da gar nichts händisch tun.

Ich schaue später noch mal ob es alternative Möglichkeiten gibt

Aber wie gesagt, VBA unter Excel ist ein Graus

 

[tox4]

Guten morgen aus Peru, der Pfad stimmt, habe ich mir direkt aus der Information einer Datei rauskopiert.

Der hineingefügte Code von mir funktioniert auch bei dir? Habe bedenken das ich beim Abschreiben etwas falsch gemacht habe und einfach nicht draufkomme.

Hilft uns das weiter? https://www.rondebruin.nl/mac/mac015.htm
oder das: https://www.rondebruin.nl/mac/mac024.htm

Echt kacke, das es nicht wie bei Windows funktioniert. Man sollte meinen das die gleich aufgebaut sind. :rolleyes:

 

[Leraje]

So, ein neuer Versuch, auch dieser klappt bei mir

Hier der Code für Copy&Paste

Sub Bildimport()

Dim i As Integer
Dim lngZeile As Long
Dim rng As Range
Dim Verzeichnis$, Bild$
Dim Bereich As Range
Dim pct As picture
Dim Zelle As Range

Verzeichnis = "/Users/ericL/Desktop/PrintReady/Thumbnail/"

lngZeile = Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row

Set Bereich = Range("B2:B" & lngZeile)

i = 2

For Each rng In Bereich
Bild = Range("B" & i).Value
Cells(i, 1).Select
Set pct = Tabelle1.Pictures.Insert(Verzeichnis & Bild)
Set Zelle = Tabelle1.Range("A" & i)
pct.Top = Zelle.Top
pct.Left = Zelle.Left
i = i + 1
Next rng

End Sub

 

[tox4]

Es ist zum Mäusemelken. Er will die Zeile mit Pictures.Insert nicht und schreibt mir den selben Fehler wie beim letzten Code.

Ich habe das File als .xlsm oder .xlsb gespeichert. Funktioniert beides nicht. Einen Button mit dem Makro hinterlegt. Der Code steht in einem Modul drinnen. Irgendetwas falsch gemacht?

Wenn ich die Zeile B1 rauslösche und das Skript nochmals starte passiert das was ich im Anhang mitsende.
Wie sieht das eigentlich bei dir aus?

 

[Leraje]

Dein Screenshot weist darauf hin dass Excel zwar ein Bild einfügen will, aber den Namen im Verzeichnis nicht findet. Dass es geht sieht man daran dass einige Bilder gefunden werden. Da müsste jetzt noch die Zeilenhöhe und Breite angepasst werden.

Wenn der Name trotzdem korrekt ist, dann könnte das evtl am Format bzw. der Endung liegen.

Unter Windows ginge es auch Bilder in einen Kommentar einzufügen, das klappt unter macOS mit den selben Befehlen leider nicht.

 

[tox4]

Sieht so aus, aber das kann gar nicht sein da die Liste der Dateinamen automatisch erstellt wurde.

Habe es gerade mit dem Code versucht aber hat leider nix geholfen mit dem Pictures.Insert

  Dim FileFormat As String
FileFormat = "{""public.jpeg""}"

Ja das hab ich leider schon mitbekommen das das unter MAC nicht funktioniert. Scheibenkleister das ganze.

 

[Leraje]

Ich versuche heute noch mal etwas anderes, aber dann gehen mir auch die Ideen aus

 

[Leraje]

Hier ein neuer Versuch:

Sub Bildeinfügen()

Dim Rw&, Pfad$, Datei$, Bild As Shape

Pfad = "/Users/ericL/Desktop/PrintReady/Thumbnail/"

With ActiveSheet
For Rw = 2 To ActiveSheet.UsedRange.Rows.Count
Datei = .Range("B" & Rw)
If Dir(Pfad & Datei) <> vbNullString Then
Cells(Rw, 1).RowHeight = 75
.Pictures.Insert (Pfad & Datei)
Set Bild = .Shapes(.Shapes.Count)
Bild.LockAspectRatio = msoTrue
Bild.Left = .Range("A" & Rw).Left
Bild.Top = .Range("A" & Rw).Top
Bild.Height = .Range("A" & Rw).Height
Else
MsgBox "Das Bild in Zelle B" & Rw & " konnte nicht gefunden werden."
End If
Next
End With

End Sub

Das Ergebnis sieht bei mir wie im Bild aus.

Die Zeilenhöhe kannst du ja deinen Bedürfnissen anpassen, das Bild wird auf die Höhe der Zeile gesetzt und in der Breite entsprechend angepasst. Da ich ja nicht weiß welche Formate deine Bilder haben müsstest du da von Hand herumexperimentieren.

Wenn's jetzt bei dir immer noch nicht geht, dann weiß ich leider auch nicht weiter.

Ich nutze übrigens die MS-Office-Version 16.27 und macOS 10.14.6

 

[tox4]

Es FUNKTIONIERT!! WOW wie geil.. Alle guten Dinge sind 3. Ich packs nicht. Vielen, Vielen Dank.

Bei manchen Bildern schreit er das er die Datei nicht findet und er will bei jedem einzelnen Foto einen Dateizugriff haben. Ich muss ihm also jeden Bild einzeln erlauben darauf zuzugreifen. Ist das bei dir auch? Macht im Prinzip nichts, da ich das nicht so oft mache. Hast du ne Idee wo ich das abdrehen kann?

 

[Leraje]

Das hatte mich auch gewundert dass er den Zugriff möchte.

Ich denke das liegt an der Sicherheitsarchitektur von macOS, da durch Makros prinzipiell auch Schadcode ausgeführt werden kann.

Beim 2. Versuch bei mir hat er aber nicht mehr nachgefragt.

Bei den nicht gefundenen Bildern solltest du den Namen noch mal überprüfen, ich weiß auch nicht ob er bei der Dateiendung zwischen Groß- und Kleinschreibung unterscheidet.

Richtig komfortabel wäre es natürlich unter Windows, wenn du beim Öffnen der Datei die Dateinamen abgleichst und dazu die Bilder in ein Kommentarfeld kopierst.

Aber leider geht auch das Ereignis Workbook.Open oder Worksheet.Activate unter macOS nicht.

Nun ja, du hast ja erst einmal eine Lösung

 

[tox4]

Ok, wenn er auch bei dir nachfragt dann passt es für mich, das ist zwar "mühsam" bei ca. 200 Fotos, das nehme ich aber gerne in Kauf. Warum musste ich mir auch Mac aussuchen? :rolleyes:

Nicht gefundene Elemente: ein paar waren mit jpEg drinnen und ein paar mit .dng (Digitales Negativ - RAW im Fotografenjargon). Mal sehen warum PS mir die Fotos bei der Thumbnailerstellung so ausgespuckt hat.
Edit: Anscheinend hab ich die Liste noch vom Original-Ordner hineinkopiert - vor der Thumbnailerstellung

Wie würde der Code auf Windows aussehen?

Schönen Montag. und nochmals vielen lieben Dank