In einem Word Dokument anhand eines Schlüsselwortes 1 oder 2 Bilder aus einem bestimmten Ordner einfügen. Der Pfad und die Bildnamen zum Schlüsselwort stehen in einer Excel Datei

Hallo,
es wäre schön wenn mir jemand auf die Sprünge helfen könnte.
Ich habe früher etwas in Excel und Access programmiert und soll nun folgende Aufgabe lösen:

In einer Excel-Datei stehen in der ersten Spalte Schlüsselwörter (z.B.: Bild1). In der zweiten Spalte steht der Pfad zu dem Ordner, in dem sich die Bilder befinden. In der 3. Spalte steht immer ein Name eines zugehörigen Bildes (z.B.: Bild1a.png) und in der vierten Spalte steht manchmal der Name eines zweiten zum Schlüsselwort gehörigen Bildes (z.B.: Bild1b.png) .

In Word soll nun nach Eingabe des Schlüsselwortes in der Zeile unter dem Schlüsselwort das zugehörige Bild (gezoomt auf die Größe: H:10,7 und B:15,1) eingefügt werden. Wenn es in der Excel Datei ein zweites Bild gibt, soll dieses auf der gleichen Seite unter dem ersten Bild, mit einer Zeilenschaltung Zwischenraum eingefügt werden.

Vielen Dank im Voraus

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 349351

Url: https://administrator.de/forum/in-einem-word-dokument-anhand-eines-schluesselwortes-1-oder-2-bilder-aus-einem-bestimmten-ordner-einfuegen-349351.html

Ausgedruckt am: 27.04.2025 um 03:04 Uhr

1 Kommentar

Servus @Savitri111 , willkommen auf Administrator.de!
Kommentare siehe VBA-Code für Word (zu legen auf einen Button oder Funktionstaste). Keyword ist vorher zu markieren

Sub InsertImagesForKeyword()
    'Variablen  
    Dim pathData As String, strKeyword As String, pos As Range, cell As Object, img As InlineShape, c As Object, strImagePath As String, fso as Object
    
    'Pfad zur Daten xlsx (hier der selbe Pfad wie das aktuelle Dokument  
    pathData = ThisDocument.Path & "\Daten.xlsx"  
    
    ' Wenn kein Keyword ausgewählt wurde beende Sub  
    If Selection.Range.Characters.Count = 1 Then
        MsgBox "Bitte markieren sie ein Keyword!", vbExclamation  
        Exit Sub
    End If
    
    'Objekte initialisieren  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    
    ' Keyword ist der markierte Text  
    strKeyword = Trim(Selection.Text)
    
    'Excel-Workbook zum lesen öffnen  
    With GetObject(pathData).Sheets(1)
        'Suche nach Keyword in Spalte A des ersten Worksheets durchführen  
        Set c = .Range("A:A").Find(strKeyword, LookIn:=-4163)  
        ' Wurde das Keyword gefunden ...  
        If Not c Is Nothing Then
            ' Inhalt der Selektion löschen  
            Selection.Delete
            'Für jedes Bild in der gefundenen Zeile zum Keyword Zeile X Spalte C:<N>  
            For Each cell In .Range(c.Offset(0, 2), .Cells(c.Row, .Columns.Count).End(-4159))
                'absoluter Pfad des Bildes zusammensetzen  
                strImagePath = c.Offset(0, 1).Value & "\" & cell.Value  
                'Wenn Bild existiert  
                If fso.FileExists(strImagePath) Then
                    'füge das Bild ein  
                    Set img = Selection.InlineShapes.AddPicture(strImagePath, True, True)
                    'Setze die Größe des Bildes  
                    img.Width = CentimetersToPoints(15.1)
                    img.Height = CentimetersToPoints(10.1)
                    'Füge zwei Absätze ein  
                    Selection.Range.InsertParagraphAfter
                    Selection.Range.InsertParagraphAfter
                    'Verschiebe die Selection 2 Absätze nach unten  
                    Selection.MoveDown wdParagraph, 2
                Else
                    MsgBox "Bild mit dem Pfad: " & strImagePath & "' wurde existiert nicht!", vbExclamation  
                End If
            Next
        Else
            'Kein Eintrag für das Keyword gefunden  
            MsgBox "Keyword wurde in der Datenbank nicht gefunden!", vbExclamation  
        End If
        'Workbook schließen  
        .Parent.Close False
    End With
    
    'Cleanup  
    Set fso = Nothing
End Sub