title image


Smiley Einfügen Grafik + Dateinamen per VBA
Hallo Profis :o)



ich möchte die Bilder + Dateinamen eines Ordners in ein Word-Dokument einfügen. Leider hilft mir ein Katalogabzug aus diversen Grafikprogrammen nicht weiter, da zwischen die Bilder noch Text eingefügt werden muss.



Ich habe in der Spitzensammlung von eku (Danke!) folgenden Code gefunden, womit alle Bilder eines Ordners in eine Tabelle eingefügt werden. So weit so gut.



Wer hilft mir bitte, den Code für mich anzupassen?

Da der Ordner ständig wechselt, würde ich diesen gern über ein Dialogfeld auswählen.

Wie kann ich unter die Bilder (in derselben Zelle) den jeweiligen Dateinamen schreiben lassen?



Private Const Pfad = "C:\Eigene Dateien\Bilder"

Private Const Filter = "jpg,gif,bmp"



Sub GrafikenInTabelleEinbringen()

  Dim oTable As Table, oCell As Cell, oILS As InlineShape

  Dim x() As String

  If Not Selection.Information(wdWithInTable) Then

    MsgBox "Die Einfügemarke befindet sich nicht in einer Tabelle."

    Exit Sub

  End If

  Set oTable = ActiveDocument.Tables(1)

  AnzZellen = oTable.Range.Cells.Count

  Extension = Filter & ","

  i = -1

  ofs = InStr(Extension, ",")

  While ofs > 0

    chk = Dir(Pfad & "\*." & Left(Extension, ofs - 1))

    While Not chk = ""

      i = i + 1

      ReDim Preserve x(i)

      x(i) = Pfad & "\" & chk

      chk = Dir

    Wend

    Extension = Mid(Extension, ofs + 1)

    ofs = InStr(Extension, ",")

  Wend

  tmp = "Es wurden " & i + 1 & " Grafiken, welche die Kriterien erfüllen gefunden."

  tmp = tmp & vbCr & "Die Tabelle enthält " & AnzZellen & " Zellen."

  tmp = tmp & vbCr & vbCr & "Möchten Sie fortfahren?"

  If MsgBox(tmp, vbOKCancel) = vbCancel Then Exit Sub

  WordBasic.SortArray x()

  i = -1

  For Each oCell In oTable.Range.Cells

    i = i + 1

    Set oILS = ActiveDocument.InlineShapes.AddPicture(FileName:=x(i), _

       LinkToFile:=False, SaveWithDocument:=True, Range:=oCell.Range)

    If i = UBound(x) Then Exit For

  Next

End Sub

Code eingefügt mit Syntaxhighlighter 1.14





Vielen Dank im Voraus für Eure Hilfe.





geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: