perola.rike
Board Regular
- Joined
- Nov 10, 2011
- Messages
- 151
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.
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.
VBA Code:
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