Extract cells in column and open word and insert into bookmark.

[molesy01]

Hi
I have Sheet.(Section A) that has text in column "E", this text would start in row 10, and could have numerous rows, say 30. I am trying to extract the text in the cells in Column E, open a template in word and insert into a bookmark. I have mastered the code to extract a cell, open the word template, and insert into a bookmark. That is where my knowledge ends.

This question is twofold.
I would like to try and understand the code to extract more than one cell in column E, it would start in r,10 and could finish in r,30.
Also i have about 10 sheets which have the same attributes with regard to same column and same cells, but obviously different text.

I have started some code but all it does is open 2 documents.
[
Sub ExportButton()

Dim objWord As Object
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Section A")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Activate
objWord.Documents.Open "C:\Users\Desktop\L2Template3.docx"
With objWord.ActiveDocument
.Bookmarks("DescriptionField").Range.Text = ws.Range("E10").Value

End With
With objWord.ActiveDocument
.Bookmarks("NameField").Range.Text = ws.Range("E12").Value
End With

Set objWord = Nothing

Set ws = ThisWorkbook.Sheets("Section B")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Activate
objWord.Documents.Open "C:\Users\Desktop\L2Template3.docx"
With objWord.ActiveDocument
.Bookmarks("StephenField").Range.Text = ws.Range("E10").Value

End With
With objWord.ActiveDocument
.Bookmarks("JohnField").Range.Text = ws.Range("E12").Value
End With

Set objWord = Nothing

End Sub
]
hope someone can help

 

[NdNoviceHlp]

So does every worksheet have all the bookmark info for the template? Does every sheet have the same info for the bookmarks in the same cell reference? What are all the bookmark names? Do you want one document for each sheet? Is every ws used or just some sheets and what are there names? As an aside, a .docx file is not a template... a template has a .dotx file extension. A .docx file can however be used to do do what you want. Maybe a bit more info is needed. HTH. Dave

 

[molesy01]

Hi Dave, thanks for your reply.

I have sheets 9 sheets, A-I, Sheet A, Sheet B, Sheet C, etc.
I have created an application with a userform to add text in column "E", which starts in r, ("E10") every entry skips a row for spacing, so the next starts again in ("E12"), there will in practice be more entries, maybe 10-15 more entries. Would be great to code the whole of column "E" until there is a space without text but i have a blank row between entries.

For example it would be great to have "E10,E12,E14" transfered to Bookmark "Description" in word.
No sure of all bookmark names yet but ive started with "RelPartyDisc" "StatusProp" "Weather" "Description"
The file extension for the word template is .dotx.
All of the sheets data will be extracted to the bookmarks which is one document called HBRTest.dotx.

Thanks for your help.
Steve

 

[NdNoviceHlp]

Hi Steve. You can give this a whirl. The file path for the template to open may need to be changed. The "E" entries should equal the number of bookmarks but there is some error prevention code included. The documents are saved as .docx to the same file location as the wb named by sheet name. If the code errors after creating the Word app, you will need to use the task manager to quit the Word application created before retesting. See what happens. Dave

Sub ExportButton()
Dim objWord As Object, WdStart As Boolean, LastRow As Integer
Dim ws As Worksheet, Acnt As Integer, BkMkCnt As Integer, ShtCnt As Integer
Dim ShtArr() As Variant, BkMkArr() As Variant
'sheet names
ShtArr = Array("Section A", "Section B", "Section C", "Section D", "Section E", _
                "Section F", "Section G", "Section H", "Section I")
'bookmark names
BkMkArr = Array("RelPartyDisc", "StatusProp", "Weather", "Description")

'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"

'lopp sheets
For Acnt = LBound(ShtArr) To UBound(ShtArr)
Set ws = ThisWorkbook.Sheets(ShtArr(Acnt))
With ws
    LastRow = .Range("E" & .Rows.Count).End(xlUp).Row
End With
'loop every other "E" entries 10-lastrow
BkMkCnt = 0
For ShtCnt = 10 To LastRow Step 2
With objWord.activedocument
If BkMkCnt <= UBound(BkMkArr) Then
If .Bookmarks.Exists(BkMkArr(BkMkCnt)) Then
.Bookmarks(BkMkArr(BkMkCnt)).Range.Text = CStr(ws.Cells(ShtCnt, "E"))
BkMkCnt = BkMkCnt + 1
End If
End If
End With
Next ShtCnt

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

 

[molesy01]

WOW, thanks Dave. Ill have a go later when im back home and get back to you.
thanks again.

 

[molesy01]

Hi Dave
There are some issues and its me not explaining it correctly. The bookmarks are relevant to each sheet, sheet A has 3 bookmarks as you can see below. Bookmarks for Sheet B are "Document" "Element" "CR" . All of the other sheets will be the same other than the Bookmark name. The only constant is the cell range, they all start in each cell in "E10". when i complete all of the sheets i would like the word doc to be created with all sheets transferring the text in their cells into each bookmark. I hope you understand. Sorry if its a pain. The example below actually works, its just coding all of the sheets im not able to do, Steve

Sub ExportButton(control As IRibbonControl)
Dim objWord As Object
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Section A")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Activate
objWord.Documents.Open "C:\Users\SM\Desktop\HBRTest.dotx" ' change as required
With objWord.ActiveDocument
.Bookmarks("RelPartyDisc").Range.Text = ws.Range("E10").Value
.Bookmarks("Weather").Range.Text = ws.Range("E12").Value
.Bookmarks("StatusProp").Range.Text = ws.Range("E14").Value
End With

Set objWord = Nothing
End Sub

 

[NdNoviceHlp]

Are the bookmarks for each sheet included in each sheet somewhere? If not, can they be listed in the same row of some unused column? Dave
ps. Does the template doc have all of the bookmarks for all sheets?

 

[molesy01]

Hi Dave
The word template doc HBRTest. dotx has all the bookmarks within the document. It's just getting the cell value of each sheet to the document.
Thanks

 

[NdNoviceHlp]

If all the bookmark names are not in each sheet, the code has to "know" what bookmark names are in each sheet ie. where to put the cell data for each sheet has to go to some specific bookmark name. Where is that information that indicates what each cell's bookmark name is? Dave

 

[molesy01]

My previous code shows the bookmark name range and cell ref.