Inventurliste in Excel mit Bildern

Question

Hallo zusammen,
ich möchte gerne eine Inventurliste in Excel (für Mac 2011) erstellen. Die Tabelle wird ca.
500 Artikeln führen. Die Liste ist bereits in Excel erstellt nun fehlen nur noch die Bilder, die
ich neben der Artikelnummer einfügen möchte.
Die Artikelnummer steht in Spalte B und das Villd soll in Spalte C eingefügt werden.
Ich habe leider noch gar nicht mit Makros oder VBA gearbeitet bin aber lernfähig. Es wäre
wirklich sehr nett, wenn mir jemand genau beschreiben könnte wie ich die Bilder
Importieren kann!

Answer 1

Hallo Joana,

ich gehe mal davon aus, dass die Artikelnummern auch gleichzeitig die Namen der entsprechenden Bilder sind.
Füge das folgende Makro in ein Standard Modul deiner Arbeitsmappe ein:

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long

'Pfad in dem die Bilder liegen - anpassen!!!
Pfad = "C:\Bilder\"
'Spalte B ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'Namen der Bilder stehen in Spalte B - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 2).Value & ".jpg"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte C eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 3).Left, Cells(Wiederholungen, 3).Top, 85, 85
Else
'falls nein, wird in Spalte C eine Fehlermeldung geschrieben
ActiveSheet.Cells(Wiederholungen, 3) = "Bild nicht gefunden"
End If
Next

End Sub

Den Pfad für die Bilder musst du natürlich auf deine Verhältnisse anpassen.

Gruß

M.O.

Answer 2

Hallo,

vielen Dank schonmal für die schnelle Antwort!
Leider klappt es bei mir noch nicht...
Die Bilder habe ich schon in "Artikel-001", "Artikel-002", usw. umbenannt. Die Artikelnummern haben die gleichen Namen.
Ich habe den Code so eingefügt:

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long

Pfad = "/Users/Joana/Desktop/Artikel"
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'Namen der Bilder stehen in Spalte B - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 2).Value & ".jpg"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) <> "" Then
'falls ja: Bilder werden in Spalte C eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 3).Left, Cells(Wiederholungen, 3).Top, 85, 85
Else
'falls nein, wird in Spalte C eine Fehlermeldung geschrieben
ActiveSheet.Cells(Wiederholungen, 3) = "Bild nicht gefunden"
End If
Next

End Sub

--> ich habe nur den Pfad eingetragen der den Weg zum Bilderordner angibt.
--> wenn ich das so lasse, dann bekomme ich diese Fehlermeldung: "Laufzeitfehler 68" -Das Gerät ist nicht verfügbar- (ein Mac Problem?)
--> muss ich bei *If Dir(strDatnam) <> "" Then* noch etwas in die Gänsefüßchen schreiben?

Ich hoffe Du/Ihr könnt mir hierbei noch einmal helfen!

Vielen Dank und viele Grüße,
Joana

Answer 3

Hallo Joana,

bei deiner Pfadangabe fehlt die Laufwerksbezeichnung und der Pfad muss mit einem Slash abschließen (siehe meinen Beispielcode):

Pfad = "C:/Users/Joana/Desktop/Artikel/"

Bei der Zeile

If Dir(strDatnam) <> "" Then

musst du nichts eintragen. Hier wird nur geprüft, ob das Bild existiert. Gibt es nämlich ein Bild mit dem Namen nicht, so wird eben dieser Leerstring zurück gegeben.

Gruß

M.O.

Answer 4

Hallo M.O.,

bei Max OSx sind die Pfade etwas anders. Um den richtigen Pfad zu haben, habe ich meinen Ordner per Drag&Drop ins Terminal gezogen. Da
wird dann direkt der Pfad erzeugt, den ich so kopieren konnte.

Wenn ich auf Makro ausführen klicke kommt auch wieder der "Laufzeitfehler 68", wenn ich dann auf "Debuggen" gehe wir mir nur die Zeile mit "If
Dir(strDatnam) <> "" Then" gelb markiert.


Vielen Dank und viele Grüße,
Joana

Answer 5

Hallo Joana,

das hängt dann wohl mit der Pfadangabe und MAC zusammen, da hier ja geprüft wird, ob die Datei in dem angegeben . Aber hast du mal im Pfad das letzte Slash-Zeichen ergänzt? Das müsste auch bei MAC noch angegeben werden.

Gruß

M.O.

Answer 6

Hallo Joana,

ich habe noch etwas im Internet gesucht.
Versuch mal probehalber die folgende Pfadangabe:

Pfad = "Macintosh HD:Users:Users:Joana:Desktop:Artikel:"

Quelle (englisch)

Gruß

M.O.

Answer 7

Hallo M.O.,

habe auch gerade recherchiert, dass bei Mac die Pfade entweder mit ":" oder "/" angegeben werden.
Zudem habe ich auch herausgefunden, dass die Funktion "Dir" nicht auf Mac funktioniert.

[Aber hast du mal im Pfad das letzte Slash-Zeichen ergänzt? Das müsste auch bei MAC noch angegeben werden.]
--> ja das habe ich gemacht, die Fehlermeldung bleibt die gleiche

[Pfad = "Macintosh HD:Users:Users:Joana:Desktop:Artikel:"]
--> das bringt mir diese Fehlermeldung: "Laufzeitfehler 76"

Vielen vielen Dank für die Bemühungen, ich hoffe wir bekommen das noch irgendwie hin!

Viele Grüße,
Joana

Answer 8

Hi M.O.,

hier ist eine Erklärung zur "Dir-Funktion" bei Mac:

[https://support.office.com/de-de/article/MacID-Funktion-b2579836-947b-42bd-b800-fafcb798869a?CorrelationId=fa19b970-c328-49a8-a40e-
bb304cd911d9&fromAR=1&omkt=de-DE&ui=de-DE&rs=de-DE&ad=DE]

vielleicht hilft Ihnen das weiter?

Viele Grüße,
Joana

Answer 9

Hallo Joana,

die DIR-Funktion scheint auf dem MAC nicht richtig zu arbeiten. Im Netz gibt es die folgende Lösung:
Füge den folgenden Code in dein VBA.-Projekt der Arbeitsmappe (nach dem End Sub des Codes zum Bilder einfügen):

Function FileOrFolderExistsOnMac(FileOrFolderstr As String) As Boolean
'Ron de Bruin : 26-June-2015
'Function to test whether a file or folder exist on a Mac in office 2011 and up
'Uses AppleScript to avoid the problem with long names in Office 2011,
'limit is max 32 characters including the extension in 2011.
Dim ScriptToCheckFileFolder As String
Dim TestStr As String

If Val(Application.Version) < 15 Then
ScriptToCheckFileFolder = "tell application " & Chr(34) & "System Events" & Chr(34) & _
"to return exists disk item (" & Chr(34) & FileOrFolderstr & Chr(34) & " as string)"
FileOrFolderExistsOnMac = MacScript(ScriptToCheckFileFolder)
Else
On Error Resume Next
TestStr = Dir(FileOrFolderstr, vbDirectory)
On Error GoTo 0
If Not TestStr = vbNullString Then FileOrFolderExistsOnMac = True
End If
End Function

Dann ändere

If Dir(strDatnam) <> "" Then

in

If FileOrFolderExistsOnMac(1, strDatnam) Then

Quelle

Ich hoffe, das übrige Makro klappt wenigstens wie auf Windows-Rechnern.

Gruß

M.O.

Answer 10

Hallo M.O.,

vielen Dank für den Code aber leider funktioniert es immer noch nicht.

Ich habe den Code so eingegeben: (und auch einmal den Pfad mit ":")

Sub Bilder_einfügen()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long

'Pfad in dem die Bilder liegen - anpassen!!!
Pfad = "/Users/Joana/Desktop/Artikel/"
'Spalte B ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
'Namen der Bilder stehen in Spalte B - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 2).Value & ".JPG"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If FileOrFolderExistsOnMac(1, strDatnam) Then
'falls ja: Bilder werden in Spalte C eingefügt, Größe 3 x 3 cm
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 3).Left, Cells(Wiederholungen, 3).Top, 85, 85
Else
'falls nein, wird in Spalte C eine Fehlermeldung geschrieben
ActiveSheet.Cells(Wiederholungen, 3) = "Bild nicht gefunden"
End If
Next

End Sub
Function FileOrFolderExistsOnMac(FileOrFolderstr As String) As Boolean
'Ron de Bruin : 26-June-2015
'Function to test whether a file or folder exist on a Mac in office 2011 and up
'Uses AppleScript to avoid the problem with long names in Office 2011,
'limit is max 32 characters including the extension in 2011.
Dim ScriptToCheckFileFolder As String
Dim TestStr As String

If Val(Application.Version) < 15 Then
ScriptToCheckFileFolder = "tell application " & Chr(34) & "System Events" & Chr(34) & _
"to return exists disk item (" & Chr(34) & FileOrFolderstr & Chr(34) & " as string)"
FileOrFolderExistsOnMac = MacScript(ScriptToCheckFileFolder)
Else
On Error Resume Next
TestStr = Dir(FileOrFolderstr, vbDirectory)
On Error GoTo 0
If Not TestStr = vbNullString Then FileOrFolderExistsOnMac = True
End If
End Function


Ich bekomme folgende Fehlermeldung:

"Fehler beim Kompilieren.: Falsche Anzahl von Argumenten oder ungültigen Eigenschaftenzuweisung." und "FileOrFolderExistsOnMac" werden
blau markiert.


Hättest Du da noch einen Tipp?


Viele Grüße,
Joana