Dateiname (Bild) automatisch einfügen

[PhilippB.]

Hallo,

ich suche eine (VBA) Lösung, wie ich nachträglich im Excel- oder Word-Dokument mir die Datei-Namen der zuvor eingefügten Bilder im Dokument anzeigen lassen zu können. Da ich über 2500 Bilder in 12 Dokumenten verteilt habe und möchte nicht einzeln die Datei-Namen nachtragen.  Über Ideen wäre ich dankbar.

VG

[Wastl]

Hi,

ich vermute mal, dass das nicht geht, zumindest fällt mir dazu nix ein, wie man den ursprünglichen Dateinamen herausbekommt in Excel. Und zu Word kann ich nix sagen, außer, dass ich im Dokument gespeicherte Bilder zwar exportieren kann, aber nicht mehr unter dem ursprünglichen Dateinamen.

Bilder behandelt Excel als shape.
Ich hab vor Jahren mal was gestrickt, das mir auflistet welche shapes in einer Exceltabelle enthalten sind.
Den Kode dazu füge ich einfach mal ein, es hat unter xl2003 einwandfrei funktioniert.
Es braucht einen freien Bereich wo es eine 7 spaltige Tabelle anlegt mit allen shapes und die Daten die sich mit vba auslesen lassen.
die Benennung der Spalten sind:

Name
AlternativeText
Height
Width
Adresse
Left
Top
Der freie Bereich kann selbst bestimmt werden, bei 2500 shapes würde ich ganz unten unter dem usedrange anfangen
Wird nichts ausgewählt, startet es in Zeile 92 und überschreibt alles was das steht
Es springt von einem shape zum anderen und dort jeweils in die Zelle, die unter der linken oberen Ecke ist.

Da es hier nur um Aufzählung geht, empfehle ich die Frage nach 'löschen' und 'unsichtbarmachen' abzuwählen
(inputbox)

Code:

Private Sub Shape8()
Dim myd As Worksheet, sh As Shapes, I As Integer, J As Integer, BiLd As String
Dim Löschmöglichkeit As Integer
Dim Unsichtbarmöglichekeit As Integer
Dim s1 As Long, s2 As Long, s3 As Long, s4 As Long, s5 As Long, s6 As Long
Dim s7 As Long, s8 As Long, s9 As Long, s10 As Long
Dim Links As Long, Oben As Long
'Dokumentationsbeginn
A = InputBox("Ich benötige 7 Spalten und viele Zeilen", "Wohin?", 92)
Löschmöglichkeit = MsgBox("Wollen Sie shapes löschen?", 289)
Unsichtbarmöglichekeit = MsgBox("Wollen Sie Shapes unsichtbar machen?", 289)
If Unsichtbarmöglichekeit = 2 Then Sichtbar = 2
If Löschmöglichkeit = 2 Then Löschen = 2
'-----
Set myd = ActiveSheet
Set sh = myd.Shapes
J = sh.Count
MsgBox J & " x Shapes enthalten"
I = 1
If J = 0 Then Exit Sub
Do
   sh(I).Visible = msoTrue
   sh(I).Select
   sh(I).Line.DashStyle = msoLineSolid
   sh(I).TopLeftCell.Select
'    Application.Wait (Now + TimeValue("0:00:2"))
s1 = myd.Columns(1).ColumnWidth
s2 = myd.Columns(2).ColumnWidth
s3 = myd.Columns(3).ColumnWidth
s4 = myd.Columns(4).ColumnWidth
s5 = myd.Columns(5).ColumnWidth
s6 = myd.Columns(6).ColumnWidth
s7 = myd.Columns(7).ColumnWidth
s8 = myd.Columns(8).ColumnWidth
s9 = myd.Columns(9).ColumnWidth
s10 = myd.Columns(10).ColumnWidth
If sh(I).Left > s1 + s2 + s3 + s4 + s5 + s6 + s7 + s8 + s9 + s10 Then
   Links = 11

End If


'    Range
   BiLd = InputBox("Was steht drin?", "shape", sh(I).AlternativeText, 1500, 12000)
   sh(I).AlternativeText = BiLd
   If sh(I).Type = msoPicture Then
       sh(I).Line.Visible = msoFalse
   End If
If Löschmöglichkeit = 1 Then
   Löschen = MsgBox("löschen?", 257)
End If
   If Löschen = 1 Then
       sh(I).Delete
       J = J - 1
       I = I - 1
       Löschen = 0
   Else
   If I = 1 Then
           Cells(A, 1) = "Name"
           Cells(A, 2) = "AlternativeText"
           Cells(A, 3) = "Height"
           Cells(A, 4) = "Width"
           Cells(A, 5) = "Adresse"
           Cells(A, 6) = "Left"
           Cells(A, 7) = "Top"
    End If
           Cells(A + I, 1) = sh(I).Name
           Cells(A + I, 2) = sh(I).AlternativeText
           Cells(A + I, 3) = sh(I).Height
           Cells(A + I, 4) = sh(I).Width
           Cells(A + I, 5) = sh(I).TopLeftCell.Address
           Cells(A + I, 6) = sh(I).Left
           Cells(A + I, 7) = sh(I).Top
           
       If Unsichtbarmöglichekeit = 1 Then
           Sichtbar = MsgBox("unSichtbar", 257)
       End If
       If Sichtbar = 2 Then
           sh(I).Visible = msoTrue
       ElseIf Sichtbar = 1 Then
           sh(I).Visible = msoFalse
       End If
   End If
I = I + 1

Loop While I < J + 1
End Sub

Excel zählt die Shape-Nummer hoch.
Alles was nicht in die Tabellen passt, Pfeile, Bilder, Textboxen oder Diagramme sind ein shape und können mit VBA von einer Form in die andere gebracht werden (teilweise) und jedes dieser Shapes bekommt eine ID, die sich in der Reihenfolge des Anlegens hochzählt.

Mit VBA lassen sich diese Shapes auch ausblenden, dann sind sie nicht sichtbar, aber immer noch vorhanden. Keine Ahnung, zu was das gut sein soll. Aber, je mehr shapes in einer Datei enthalten sind, desto langsamer wird die Datei zum bearbeiten. Auch da weiß ich den Grund nicht…

[PhilippB.]

Ich teste das mal und schaue wie weit ich komme. !

[PhilippB.]

Moin,

ich habe einen aus dem Netz gefundenen VBA-Code angepasst. Und es funktioniert. Es wird der Pfad und der DateiName angezeigt. Leider wird das erste letzte Foto als erstes angezeigt. Ab Bild zwei läuft alles in der richtigen Reihenfolge. vllt findet jemand den fehler?!

Hier der Code:

Code:

Sub PfadDateiNamenEinfügen()
   Dim fso, d1, file, fileName
   Set fso = CreateObject("Scripting.FileSystemObject")
   fileName = "................."
   ' Pfad anpassen
   Set d1 = fso.GetFolder(fileName)
   For Each file In d1.Files
      Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
      Selection.TypeParagraph
      Selection.InlineShapes.AddPicture fileName:= _
          file, LinkToFile:=True, SaveWithDocument:=False
      Selection.TypeParagraph
      Selection.InsertCaption Label:="Abbildung", TitleAutoText:="", Title:=" - " + file, _
          Position:=wdCaptionPositionBelow, ExcludeLabel:=0
      Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
      Selection.TypeParagraph
   Next
End Sub

Gruß,
Philipp

[PhilippB.]

Es wird der Pfad und der DateiName angezeigt. Leider wird das erste letzte Foto als erstes angezeigt. Ab Bild zwei läuft alles in der richtigen Reihenfolge.

Hat jemand eine Idee, wie ich das ändern kann, sodass das letzte Bild nicht das erste ist?

[Rabe]

Hi Phlipp,

was ich mich nur frage:

Woher weiß Excel, welches der 2500 Bilder, die Du schon in Deiner Datei eingefügt hattest, welcher Datei entspricht, um dann Pfad und Dateiname auszulesen?

[schauan]

Hallöchen,

wenn das erste Bild falsch ist, muss doch mindestens noch ein anderes falsch sein, oder sehe ich da was falsch ?

Ansonsten kann das nur funktionieren, wenn Du die Bilder in einer Sortierreihenfolge eingefügt hast, bevorzugt nach Dateiname. Hast Du z.B. das Erstell- oder Änderungsdatum / Zeit genommen, kann es bei einem Austausch von Bildern schon durcheinander gehen.
Da hilft dann nur manuelles Nachbearbeiten. Im Code müsstest Du dann die Reihenfolge ebenfalls sortiert abarbeiten.

Ebenso kann ein nachträglicher Austausch von Bildern zu einer falschen Reihenfolge führen. Das geht dann nur manuell zu korrigieren.

[Wastl]

Hi,
Ich habe versucht den code in excel zu testen.
er tut nit.
er hängt schon bei dieser Zeile

Code:

Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter

googlen ergibt das es sich um MSWord handelt, also nicht Excel
hab auch ne Word datei mit Bildern drin und den Code da eingebaut.

Der Code liest bei mir keine Namen und Pfade aus, sondern
Er baut aus dem angegebenen Pfad Bilder ein und schreibt den Pfadnamen darunter.
Das ist lustig, allerdings deckt sich das nicht mit dem Text des ersten Posts des Themenstarters.

Ist also
1. im Excelforum falsch plaziert
2. Nicht die Lösung auf den 1. Post sondern was ganz anderes.

Leider hat sich meine Meinung dadurch nicht geändert, in der ich glaube, dass das in Excel nicht geht.
Ich wäre gerne vom Gegenteil überzeugt worden.