Excel cell value with space between paragraphs with excel to word bookmark

[molesy01]

Hi
I have a userform in excel that copies text from a cell and puts it within a bookmark in a word template. I have created code which works however the issue i have is that i require more than 1 cell value to populate into a single bookmark with a space between the paragraphs. Hope someone can help. Thanks

sub ExportButton(control As IRibbonControl)

Dim objWord As Object
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Testing")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Activate
objWord.Documents.Open "\\Desktop\Testing.dotm"
With objWord.ActiveDocument
.Bookmarks("RPD").Range.Text = ws.Range("E10").Value
.Bookmarks("RPD").Range.Text = ws.Range("E12").Value
.Bookmarks("RPD").Range.Text = ws.Range("E14").Value

End With

Set objWord = Nothing

End Sub

 

[molesy01]

Hi Dave. Thanks for this, it errors on

objWord.ActiveDocument.Bookmarks(i).Range.Text = vbNullString.

It says the range cannot be deleted.

 

[NdNoviceHlp]

Trial...

objWord.ActiveDocument.Bookmarks(i).Range.Text = ""

 

[molesy01]

Trial...

objWord.ActiveDocument.Bookmarks(i).Range.Text = ""

Still no luck, it errors on that line of code too.

 

[NdNoviceHlp]

Maybe change this bit...
'clear bookmarks

For i = LBound(BkMkArr) To UBound(BkMkArr)
objWord.ActiveDocument.Bookmarks(BkMkArr(i)).Range.Text = ""
Next i

 

[NdNoviceHlp]

Missed the -1...

'clear bookmarks
For i = LBound(BkMkArr) To UBound(BkMkArr) - 1
objWord.ActiveDocument.Bookmarks(BkMkArr(i)).Range.Text = ""
Next i

 

[NdNoviceHlp]

Apologies Steve, I forgot how VBA bookmarks work. When you insert text it destroys the bookmark so you need to replace it if you're planning on using it again. Here's the corrected code to trial. Dave

Sub ExportButton()
Dim objWord As Object, WdStart As Boolean, LastRow As Integer, i As Integer, BCnt As Integer
Dim ws As Worksheet, BkMkCnt As Integer, ShtCnt As Integer, RowCnt As Integer, orng As Object
Dim ShtArr() As Variant, BkMkArr() As Variant, TempStr As String, BKName As String
'sheet names
ShtArr = Array("Section A", "Section B", "Section C", "Section D", "Section E", _
                "Section F", "Section G", "Section H", "Section I")

'start Word app
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
On Error GoTo 0
Set objWord = CreateObject("Word.Application")
WdStart = True
End If
'open template *********change path to suit
objWord.Visible = False
objWord.Documents.Open "C:\Users\Desktop\HBRTest.dotx"

'load bookmarks into an array
ReDim BkMkArr(objWord.ActiveDocument.Bookmarks.Count)
For i = 1 To objWord.ActiveDocument.Bookmarks.Count
BkMkArr(i - 1) = objWord.ActiveDocument.Range.Bookmarks(i)
Next i

'loop sheets
For ShtCnt = LBound(ShtArr) To UBound(ShtArr)
'clear bookmarks
For i = LBound(BkMkArr) To UBound(BkMkArr) - 1
Set orng = objWord.ActiveDocument.Bookmarks(BkMkArr(i)).Range
orng.Text = vbNullString
objWord.ActiveDocument.Bookmarks.Add BkMkArr(i), orng
Next i

'set ws and lastrow "E"
Set ws = ThisWorkbook.Sheets(ShtArr(ShtCnt))
With ws
    LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With

'loop every other "E" entry (10 to lastrow)
For RowCnt = 10 To LastRow Step 2
TempStr = CStr(ws.Cells(RowCnt, "E"))
BKName = CStr(ws.Cells(RowCnt, "F"))

'if more than one "E" row in same bookmark make string
For BkMkCnt = (RowCnt + 2) To LastRow Step 2
If CStr(ws.Cells(RowCnt, "F")) = CStr(ws.Cells(BkMkCnt, "F")) Then
TempStr = TempStr & Chr(11) & CStr(ws.Cells(BkMkCnt, "E"))
Else
Exit For
End If
Next BkMkCnt

'put "E" string in bookmark
With objWord.ActiveDocument
'search for bookmark
For BCnt = LBound(BkMkArr) To UBound(BkMkArr) - 1
If .Bookmarks(BkMkArr(BCnt)) = BKName Then
Set orng = objWord.ActiveDocument.Bookmarks(BkMkArr(BCnt)).Range
orng.Text = TempStr
objWord.ActiveDocument.Bookmarks.Add BkMkArr(BCnt), orng
Exit For
End If
Next BCnt
End With

Next RowCnt

'save *********change path to suit
objWord.ActiveDocument.SaveAs2 (ThisWorkbook.Path & "\" & ShtArr(ShtCnt) & ".docx")
Next ShtCnt
'close template/clean up
objWord.ActiveDocument.Close savechanges:=False
If WdStart Then
objWord.Quit
Set objWord = Nothing
End If
End Sub

 

[molesy01]

Hi Dave, thanks again for your hard work, it keeps getting an error highlighted in yellow, orng.Text = vbNullString

 

[NdNoviceHlp]

Morning Steve. I made up a test doc and trialed that line of code (and inserting text to the bookmark) before posting the last code version. There must be something else going on. Trial adding the message box line of code below to see if the bookmark array is populating. Dave

'load bookmarks into an array
ReDim BkMkArr(objWord.ActiveDocument.Bookmarks.Count)
For i = 1 To objWord.ActiveDocument.Bookmarks.Count
BkMkArr(i - 1) = objWord.ActiveDocument.Range.Bookmarks(i)
MsgBox BkMkArr(i - 1) '**********ADD THIS LINE
Next i
[CODE=vba]

 

[molesy01]

Morning Dave.
Yes, the bookmark array is populating fine. Ive just been through all of the bookmarks with the MsgBox that pops up and lists them. When it completed the same error came up.
Thanks

 

[NdNoviceHlp]

Puzzling... works fine for me. Trial this again.

orng.Text = ""