saurav2386
New Member
- Joined
- Jan 16, 2014
- Messages
- 1
HI guys,
I want to export a excel column(Jointno.) to a word report(Template) which also has coloumn(Jointno.---> Bookmarked Joint).
both the excel and word has exactly 16 rows.
I just want to copy the 16 rows of data and paste it into the bookmarked location in word.
I have go the following Code:-
Any help will be seriously appreciated.
Thanks in ADVANCE
I want to export a excel column(Jointno.) to a word report(Template) which also has coloumn(Jointno.---> Bookmarked Joint).
both the excel and word has exactly 16 rows.
I just want to copy the 16 rows of data and paste it into the bookmarked location in word.
I have go the following Code:-
Code:
Sub Create_Letters()
' Note: you will need to add error-trapping
Dim objX As Object
Dim rng1 As Range
Dim rng2 As Range
Dim wb As Workbook
Dim wsControl As Worksheet
Dim wsData As Worksheet
'
Dim oApp As Word.Application
Dim oBookMark As Word.Bookmark
Dim oDoc As Word.Document
'
Dim strDocumentFolder As String
Dim strTemplate As String
strTemplate = "C:\Letter Creator\Word Templates\exp.docx"
Dim strTemplateFolder As String
Dim strWordDocumentName As String
Dim cell As Range
'
Set wb = ThisWorkbook
Set wsControl = wb.Worksheets("Control Sheet")
wsControl.Activate
Set wsData = wb.Worksheets(wsControl.[Data_Sheet].Value)
strTemplateFolder = wsControl.[Template_Folder].Value
strDocumentFolder = wsControl.[Document_Folder].Value
wsData.Activate
' number of letters required:
' must not have any blank cells in column A - except at the end
Set rng1 = wsData.Range("d2:d17")
rng1.Select
Selection.Copy
'
'Set oApp = CreateObject("Word Application")
Set oApp = New Word.Application
' Process each record in turn
For Each cell In rng1
Set oDoc = oApp.Documents.Add
oApp.Selection.InsertFile strTemplate
' locate each bookmark
For Each oBookMark In oDoc.Bookmarks
Set objX = wsData.Rows.Find(oBookMark.Name, LookIn:=xlValues, LookAt:=xlWhole)
If Not objX Is Nothing Then
' found
If Right(oBookMark.Name, 4) = "joint" Then
oBookMark.wdGoTo What:=wdGoToBookmark, Name:="joint"
With ActiveDocument.Bookmarks
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Selection.PasteAndFormat (wdPasteDefault)
Selection.Font.Bold = wdToggle
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
End If
Else
MsgBox "Bookmark '" & oBookMark.Name & "' not found", vbOKOnly + vbCritical, "Error"
GoTo Tidy_Exit
End If
Next oBookMark
'
oDoc.SaveAs "C:\Letter Creator\Documents\exp1.docx"
oDoc.Close
Next cell
'
Tidy_Exit:
On Error Resume Next
Set oDoc = Nothing
Set oBookMark = Nothing
Set objX = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
oApp.Quit
Set oApp = Nothing
'
Set wsData = Nothing
Set wsControl = Nothing
Set wb = Nothing
'
End Sub
Thanks in ADVANCE
Last edited by a moderator: