Export from Excel to Word - insert picture after specific text string?

[perola.rike]

I have a sheet that contains multiple rows with text (a report) that is exported to a Word document.
What I want, but after some years of trying now and then with no luck, is to insert a picture in the Word dokument after a specific text string in the document, i.e., "INSERT PICTURE HERE"
In the code below, the lines after INSERT A PICTURE insert my picture in Word, but it is placed on the top. How to insert the picture after the text (in the report) INSERT PICTURE HERE?
I've tried bookmarks, but havent figured it out.

Any help/hints are very appreciated!

This is the Excel to Word export code, the rows with text are on the "Rapport" (i.e. report in Norwegian) sheet. The data are tranferred to the "Export" sheet, filtered there before pasted into a Word document.

Sub wordrapport_open()
     Dim wd As Object
     Dim FileExtStr As String
     Dim FileFormatNum As Long
     Dim FolderName As String
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        Application.Calculation = xlCalculationManual
        Sheets("export").Range("A1:A500").ClearContents
        Sheets("export").Range("B1:B500").ClearContents
        Sheets("rapport").Columns("A:A").Copy
        Set wsd = Sheets("export")
        With wsd
        .Range("A1:A200").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=True
        End With
        
        CopyOnlyValuesAndFormat
        lager_italic_paadetfoer_kolon_wordexport
        'Sheets("export").Range("A1:A500").ClearContents
        'cellslette
        Sheets("export").Range("$F$1:$F$300").AutoFilter Field:=1, Criteria1:="0"
        
        
        Worksheets("export").Range("A1:A2000").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        Dim wdApp As Object, wdDoc As Object, wdRng As Object 'word koder starter her
        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        If Err.Number <> 0 Then
        Set wdApp = CreateObject("Word.Application")
        End If
        On Error GoTo 0
        Set wdDoc = wdApp.Documents.Add
        'en refresherfilter
        
        Sheets("export").Range("B1:B100").Copy
        Set wdRng = wdDoc.Range
        With wdRng
        .Collapse Direction:=0
        .Paste
        .End = .Tables(1).Range.End + 1
        .Tables(1).ConvertToText 0
        '.Font.Size = 12
        .Copy
        While .Paragraphs.Count > 1
        .Paragraphs(1).Range.Characters.Last = Chr(11)
        Wend
        End With
        wdApp.Visible = True
        'wdApp.Visible = False 
    
     'INSERT A PICTURE
        If Environ("username") = "Bruker" Then
        With wdApp.Selection
        eksport_samleprofil_clipboard_2
        .Range.Paste
        Application.CutCopyMode = False
        End With
        End If
      
    
    Application.DisplayAlerts = True
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayFormulaBar = True
    ActiveWindow.DisplayHeadings = True
    
    Sheets("export").Range("$F$1:$G$300").AutoFilter Field:=1
    
End Sub

 

[John_w]

Try this:

    'INSERT A PICTURE
    If Environ("username") = "Bruker" Then
        Set wdRng = wdDoc.Range
        With wdRng
            .Find.ClearFormatting
            .Find.Execute FindText:="INSERT PICTURE HERE", Forward:=True, Format:=False, Wrap:=wdFindStop
            If .Find.Found Then
                 eksport_samleprofil_clipboard_2
                .Paste
            End If
            Application.CutCopyMode = False
        End With
    End If

 

[perola.rike]

Amazing! Worked perfectly. Such a nice code, I've been trying to solve this for years....Thank you!