Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1624to1628
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Bilder mit Dateinamen versehen?
04.06.2018 14:00:03
kathrin
Liebes Forum,
ich bin hier neu und hätte gleich mal eine Frage:
Ich habe ein Makro, welches mir bei entsprechender Eingabe des Pfades alle Bilder, die unter dem Pfad zu finden sind, in ein neues Tabellenblatt kopiert (siehe Beispielscode unten)...Jetzt hätte ich noch gerne unter jedes Bild, welches kopiert wird, den entsprechenden Dateinamen. Allerdings weiß ich leider nicht so recht, wie ich das machen soll. Habt ihr da eine Idee?
VG Kathrin
Private Sub CommandButton1_Click()
Dim strVerz As String, strDatei As String, pic As Picture
Dim iBreite As Integer, iAnz As Integer, lAnz As Long, lZ As Long
Dim wksBilder As Worksheet, wksDaten As Worksheet
Dim lHoehe As Long, lBildHoehe As Integer
Application.ScreenUpdating = False
Set wksDaten = ActiveSheet
'Bilder-Breite
iBreite = 300
'Anzahl der Bilder-Verzeichnisse
lAnz = Range("A" & Rows.Count).End(xlUp).Row
'Tabellenblatt für Bilder erstellen
Sheets.Add After:=Sheets(Sheets.Count)
Set wksBilder = ActiveSheet
'Verzeichnisse durchlaufen
For lZ = 2 To lAnz
'Bild-Dateinamen ermitteln
strVerz = wksDaten.Cells(lZ, 1) & wksDaten.Cells(lZ, 2) & "\" & wksDaten.Cells(lZ, 3) & "\"
strDatei = Dir(strVerz & "*.jpg")
'Bilder einfügen
Do While strDatei  ""
For iAnz = 1 To 2
If InStr(strDatei, wksDaten.Cells(lZ, 4)) > 0 Then
If iAnz = 1 Then lHoehe = lHoehe + lBildHoehe + 10
Set pic = ActiveSheet.Pictures.Insert(strVerz & "\" & strDatei)
If pic.Width > iBreite Then pic.Width = iBreite
pic.Left = (iAnz - 1) * (iBreite + 10)
pic.Top = lHoehe
If iAnz > 1 Or lBildHoehe 

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bilder mit Dateinamen versehen?
04.06.2018 14:43:36
Robert
Hallo kathrin,
füge nachstehende rote Zeile ein:
...
If iAnz > 1 Or lBildHoehe 
Cells(pic.BottomRightCell.Row + 1, pic.TopLeftCell.Column) = strDatei
Else
...
Gruß
Robert
AW: Bilder mit Dateinamen versehen?
04.06.2018 15:04:55
kathrin
Hi Robert,
vielen Dank für deine Antwort! Allerdings kopiert es jeden Dateinamen in "Tabelle1", wo der entsprechende Pfad hinterlegt ist und nicht unter die jeweiligen Bilder in "Tabelle2", die neu durch das Makro generiert wird...Hast du dafür eine Lösung noch? Nochmals danke...
Außerdem habe ich bisher die Methode mit ActiveSheet.Pictures.Insert benutzt. Wenn man die Datei allerdings auf einem anderen Computer aufmacht, sind die Bilder nicht mehr zu sehen, sondern nur eine graue Schattierung der Bilder. Dies liegt wie ich gelesen habe an dieser benutzten Methode…Die Methode ActiveSheet.Shapes.AddPicture soll hier wie ich gelesen habe, Abhilfe schaffen. Allerdings weiß ich leider nicht, wie ich meinen bsiherigen Code umgestalten muss…Hättest du dafür auch eine Lösung? Das wäre sehr hilfreich!
Anzeige
AW: Bilder mit Dateinamen versehen?
04.06.2018 16:16:18
Robert
Hallo kathrin,
da kann ich mir nichts davon erklären.
Die Dateinamen müssten, wenn beim Cells-Objekt nichts weiter angegeben ist, im aktiven Tabellenblatt eingefügt werden. Das aktive Tabellenblatt ist nach der Sheets.Add-Anweisung das neue Tabellenblatt zur Aufnahme der Bilder. Du könntest halt nur mal versuchen, das Tabellenblatt noch explicit mit anzugeben:
wksBilder.Cells(pic.BottomRightCell.Row + 1, pic.TopLeftCell.Column) = strDatei
Dass die Bilder auf einem anderen Computer nicht sichtbar sind, war mir neu. Im Internet fand ich einen Hinweis, dass dieses Problem ab Excel2010 auftritt. Ich arbeite hier noch mit Excel2007 und kann das nicht beurteilen. Falls es so sein sollte, kannst Du es vielleicht wie folgt probieren:
Sub CommandButton1_Click()
Dim strVerz As String, strDatei As String, pictureShape As Shape
Dim iBreite As Integer, iAnz As Integer, lAnz As Long, lZ As Long
Dim wksBilder As Worksheet, wksDaten As Worksheet
Dim lHoehe As Long, lBildHoehe As Integer
Application.ScreenUpdating = False
Set wksDaten = ActiveSheet
'Bilder-Breite
iBreite = 300
'Anzahl der Bilder-Verzeichnisse
lAnz = Range("A" & Rows.Count).End(xlUp).Row
'Tabellenblatt für Bilder erstellen
Sheets.Add After:=Sheets(Sheets.Count)
Set wksBilder = ActiveSheet
'Verzeichnisse durchlaufen
For lZ = 2 To lAnz
'Bild-Dateinamen ermitteln
strVerz = wksDaten.Cells(lZ, 1) & wksDaten.Cells(lZ, 2) & "\" & wksDaten.Cells(lZ, 3) & "\"
strDatei = Dir(strVerz & "*.jpg")
'Bilder einfügen
Do While strDatei  ""
For iAnz = 1 To 2
If InStr(strDatei, wksDaten.Cells(lZ, 4)) > 0 Then
If iAnz = 1 Then lHoehe = lHoehe + lBildHoehe + 10
'Bild einfügen
Set pictureShape = wksBilder.Shapes.AddPicture(strVerz & "\" & strDatei, _
False, True, (iAnz - 1) * (iBreite + 10), lHoehe, -1, -1)
'Größe anpassen
If pictureShape.Width > iBreite Then
pictureShape.Width = iBreite
End If
If iAnz > 1 Or lBildHoehe Else
iAnz = iAnz - 1
End If
strDatei = Dir    ' Nächsten Eintrag abrufen.
If strDatei = "" Then Exit For
Next iAnz
Loop
Next
'Aufräumen
Set pictureShape = Nothing
Set wksBilder = Nothing
Set wksDaten = Nothing
Application.ScreenUpdating = True
End Sub
Gruß
Robert
Anzeige

6 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige