Tombstone07
08-02-2016, 06:38 AM
Hello VBAExpress community!
I've been Reading from the answers given through these fórums and it's been great so far...
Right now I have an Excel Sheet, in it I run a Macro that checks values in a column, opens a Word Doc and populates it with the relevant information found in the active row; this opens several files, and I was hoping to find a way in which all these documents could be opened as a single file; or that, once the code saves them, have the option to merge all files into one.
Dim wrdLttrX As Object
Dim fnameX As String
fnameX = "Carta X" 'change to suit
Dim ws As Worksheet
Dim wrdLttrY As Object
Dim fnameY As String
fnameY = "Carta Y" 'change to suit
Range("E11").Select
Do While (Left(ActiveCell.Value, 2) = "X " Or Left(ActiveCell.Value, 2) = "Y ")
For Each CeldaFigura In Selection
Set ws = ThisWorkbook.ActiveSheet
Set wrdLttrX = CreateObject("Word.Application")
Set wrdLttrY = CreateObject("Word.Application")
If (Left(ActiveCell.Value, 2) = "X ") Then
wrdLttrX.Documents.Open (ThisWorkbook.Sheets("Parámetros").Range("B2").Value) 'I have Another Sheet with the folder address indicating where the Word Template can be found
wrdLttrX.Visible = True
With wrdLttrX
DocNum = DocNum + 1
.ActiveDocument.SaveAs2 Filename:=ThisWorkbook.Sheets("Parámetros").Range("B10").Value & "\" & fnameX & DocNum & ".docx", FileFormat:=wdFormatDocument
End With
With wrdLttrX.ActiveDocument
.Bookmarks("Bookmark_1").Range.Text = ws.Range("D7").Value
.Bookmarks("Bookmark_2").Range.Text = ws.Range("C" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_3").Range.Text = ws.Range("D" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_4").Range.Text = ws.Range("B7").Value
.Bookmarks("Bookmark_5").Range.Text = ws.Range("C7").Value
.Bookmarks("Bookmark_6").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_7").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
End With
End If
If (Left(ActiveCell.Value, 2) = "Y ") Then
wrdLttrY.Documents.Open (ThisWorkbook.Worksheets("Parámetros").Range("B4").Value) 'I have Another Sheet with the folder address indicating where the Word Template can be found
wrdLttrY.Visible = True
With wrdLttrY
DocNum = DocNum + 1
.ActiveDocument.SaveAs2 Filename:=ThisWorkbook.Sheets("Parámetros").Range("B10").Value & "\" & fnameY & DocNum & ".docx", FileFormat:=wdFormatDocument
End With
With wrdLttrY.ActiveDocument
.Bookmarks("Bookmark_1").Range.Text = ws.Range("D7").Value
.Bookmarks("Bookmark_2").Range.Text = ws.Range("C" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_3").Range.Text = ws.Range("D" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_4").Range.Text = ws.Range("B7").Value
.Bookmarks("Bookmark_5").Range.Text = ws.Range("C7").Value
.Bookmarks("Bookmark_6").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_7").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
End With
End If
Next CeldaFigura
ActiveCell.Offset(1, 0).Select
Loop
End Sub
This is the section of the Code that Opens a Word template, populates the text with the infor in the Excel table, and "saves" it.
I need a way to either make it open all the docs in one file (with pagebreaks if posible to make it look organized) or once they are saves, merge them.
I've been Reading from the answers given through these fórums and it's been great so far...
Right now I have an Excel Sheet, in it I run a Macro that checks values in a column, opens a Word Doc and populates it with the relevant information found in the active row; this opens several files, and I was hoping to find a way in which all these documents could be opened as a single file; or that, once the code saves them, have the option to merge all files into one.
Dim wrdLttrX As Object
Dim fnameX As String
fnameX = "Carta X" 'change to suit
Dim ws As Worksheet
Dim wrdLttrY As Object
Dim fnameY As String
fnameY = "Carta Y" 'change to suit
Range("E11").Select
Do While (Left(ActiveCell.Value, 2) = "X " Or Left(ActiveCell.Value, 2) = "Y ")
For Each CeldaFigura In Selection
Set ws = ThisWorkbook.ActiveSheet
Set wrdLttrX = CreateObject("Word.Application")
Set wrdLttrY = CreateObject("Word.Application")
If (Left(ActiveCell.Value, 2) = "X ") Then
wrdLttrX.Documents.Open (ThisWorkbook.Sheets("Parámetros").Range("B2").Value) 'I have Another Sheet with the folder address indicating where the Word Template can be found
wrdLttrX.Visible = True
With wrdLttrX
DocNum = DocNum + 1
.ActiveDocument.SaveAs2 Filename:=ThisWorkbook.Sheets("Parámetros").Range("B10").Value & "\" & fnameX & DocNum & ".docx", FileFormat:=wdFormatDocument
End With
With wrdLttrX.ActiveDocument
.Bookmarks("Bookmark_1").Range.Text = ws.Range("D7").Value
.Bookmarks("Bookmark_2").Range.Text = ws.Range("C" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_3").Range.Text = ws.Range("D" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_4").Range.Text = ws.Range("B7").Value
.Bookmarks("Bookmark_5").Range.Text = ws.Range("C7").Value
.Bookmarks("Bookmark_6").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_7").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
End With
End If
If (Left(ActiveCell.Value, 2) = "Y ") Then
wrdLttrY.Documents.Open (ThisWorkbook.Worksheets("Parámetros").Range("B4").Value) 'I have Another Sheet with the folder address indicating where the Word Template can be found
wrdLttrY.Visible = True
With wrdLttrY
DocNum = DocNum + 1
.ActiveDocument.SaveAs2 Filename:=ThisWorkbook.Sheets("Parámetros").Range("B10").Value & "\" & fnameY & DocNum & ".docx", FileFormat:=wdFormatDocument
End With
With wrdLttrY.ActiveDocument
.Bookmarks("Bookmark_1").Range.Text = ws.Range("D7").Value
.Bookmarks("Bookmark_2").Range.Text = ws.Range("C" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_3").Range.Text = ws.Range("D" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_4").Range.Text = ws.Range("B7").Value
.Bookmarks("Bookmark_5").Range.Text = ws.Range("C7").Value
.Bookmarks("Bookmark_6").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
.Bookmarks("Bookmark_7").Range.Text = ws.Range("B" & (ActiveCell.Row)).Value
End With
End If
Next CeldaFigura
ActiveCell.Offset(1, 0).Select
Loop
End Sub
This is the section of the Code that Opens a Word template, populates the text with the infor in the Excel table, and "saves" it.
I need a way to either make it open all the docs in one file (with pagebreaks if posible to make it look organized) or once they are saves, merge them.