Hallo zusammen nochmal,

ich suche mir eine Liste mit Bildern zusammen. Dafür durchsuche alle Verzeichnisse mit UnterOrdnern - das klappt.

In dem Fließtext sind "Codewörter" enthalten, die so heißen wie die Bilder.

Jetzt soll die Liste abgearbeitet werden: Suche nach dem CodeWort, lösche es und füge DORT das Bild ein.

Codewort wird gelöscht und ein Bild eingefüt, aber da wo bei Makrostart der Cursor stand...

Sub BildRein(ByVal PicName As String)
'
Selection.HomeKey Unit:=wdStory

Selection.GoTo What:=wdGoToPage, Count:=vSeite
Selection.MoveDown Unit:=wdLine, Count:=vZeile - 1
Selection.MoveRight Unit:=wdCharacter, Count:=vStep
    Selection.InlineShapes.AddPicture FileName:=PicName, LinkToFile:=False, SaveWithDocument:=True

End Sub

Sub PfadeDurchsuchen()
Dim vPath As String
vPath = ActiveDocument.path
vPath = Replace(vPath, "000-Docs", "")
LoopThroughFolder vPath
End Sub

Public Sub LoopThroughFolder(path As String)
Dim vPfad() As String, vName() As String, vHilf As String
Dim vZahl As Integer, i As Integer
vZahl = 0
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
On Error Resume Next 'Falls Permission denied nächsten Folder/File nehmen (quick n dirty)
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(path)
Do While queue.Count > 0
    Set oFolder = queue(1)
    queue.Remove 1
    For Each oSubfolder In oFolder.SubFolders
     If oSubfolder <> vbEmpty Then queue.Add oSubfolder
    Next
    For Each oFile In oFolder.Files
       If oFile <> vbEmpty Then
                vZahl = vZahl + 1
                ReDim Preserve vPfad(vZahl)
                ReDim Preserve vName(vZahl)
                                
                vPfad(vZahl) = oFile.path
                vName(vZahl) = getName(oFile.path)
        End If
    Next
    Loop
    
    For i = LBound(vPfad) To UBound(vPfad) - 1
    vFound = False
    Call Ersetzungen2(vName(i), "")
    If vFound = True Then
    Call BildRein(vPfad(i))
    End If
    
    Next
        
End Sub

Function getName(pf): getName = Split(Mid(pf, InStrRev(pf, "\") + 1), ".")(0): End Function

Sub Ersetzungen2(ByVal txtSuch As String, ByVal txtErsetz As String)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = txtSuch
        .Replacement.Text = txtErsetz
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        vFound = True
        vSeite = Selection.Information(wdActiveEndPageNumber)
        vZeile = Selection.Information(wdFirstCharacterLineNumber)
        vStep = Selection.Information(wdFirstCharacterColumnNumber) - 1
      End With
        Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Wie kriege ich das Bild dahin, wo vorher das CodeWort stand??

Besten Dank!!

FlyingGancho