Hi all,
I currently have 2 x codes to copy data from an excel spreadsheet into a word template when a command button on a userform is selected. The two codes are to paste text and pictures.
Sub Procedure1()
Dim objWord As Object
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet6")
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open "C:\Users\Christopher.Ellis\Desktop\VBA Testing\CPA Test\Test1.docx" ' change as required
With objWord.ActiveDocument
.Bookmarks("C1").Range.Text = ws.Range("C25").Value
.Bookmarks("C2").Range.Text = ws.Range("C25").Value
.Bookmarks("Co1").Range.Text = ws.Range("C26").Value
.Bookmarks("Cl1").Range.Text = ws.Range("C27").Value
.Bookmarks("Ex_1").Range.Text = ws.Range("C28").Value
.Bookmarks("Ex_2").Range.Text = ws.Range("C28").Value
.Bookmarks("S1").Range.Shading.BackgroundPatternColor = ws.Range("C29").Interior.Color
.Bookmarks("S2").Range.Shading.BackgroundPatternColor = ws.Range("C29").Interior.Color
.Bookmarks("S3").Range.Shading.BackgroundPatternColor = ws.Range("C29").Interior.Color
.Bookmarks("S3").Range.Shading.BackgroundPatternColor = ws.Range("C29").Interior.Color
.Bookmarks("S1").Range.Font.ColorIndex = ws.Range("C29").Font.ColorIndex
.Bookmarks("S2").Range.Font.ColorIndex = ws.Range("C29").Font.ColorIndex
.Bookmarks("S3").Range.Font.ColorIndex = ws.Range("C29").Font.ColorIndex
.Bookmarks("S4").Range.Font.ColorIndex = ws.Range("C29").Font.ColorIndex
.Bookmarks("S1").Range.Text = ws.Range("C29").Value
.Bookmarks("S2").Range.Text = ws.Range("C29").Value
.Bookmarks("S3").Range.Text = ws.Range("C29").Value
.Bookmarks("S4").Range.Text = ws.Range("C29").Value
.Save
.Close
End With
Set objWord = Nothing
End Sub
Sub Procedure2()
' Excel parameters
Const sSHEET_NAME As String = "Sheet6"
' Word parameters
Const sTARGET_PATH As String = "C:\Users\Christopher.Ellis\Desktop\VBA Testing\CPA Test\"
Const sTARGET_NAME As String = "GR1 CPA Test1.docx"
Dim sBookmarkName As String
Dim sRangeToCopy As String
Dim vaDataValues As Variant
Dim objWord As Object
Dim iRowNo As Integer
Dim wks As Worksheet
ReDim vaDataValues(1 To 4, 1 To 2)
vaDataValues(1, 1) = "B2:G23"
vaDataValues(1, 2) = "CW1"
vaDataValues(2, 1) = "I25:P35"
vaDataValues(2, 2) = "C1"
vaDataValues(3, 1) = "D2"
vaDataValues(3, 2) = "D2"
vaDataValues(4, 1) = "I2"
vaDataValues(4, 2) = "I2"
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open sTARGET_PATH & sTARGET_NAME
Set wks = ThisWorkbook.Sheets(sSHEET_NAME)
For iRowNo = LBound(vaDataValues, 1) To UBound(vaDataValues, 1)
sRangeToCopy = vaDataValues(iRowNo, 1)
sBookmarkName = vaDataValues(iRowNo, 2)
wks.Range(sRangeToCopy).CopyPicture
objWord.ActiveDocument.Bookmarks(sBookmarkName).Range.Paste
Next iRowNo
Set objWord = Nothing
Set wks = Nothing
End Sub
Currently once the codes have been run and the word document is produced I save it somewhere and then if I need to do it again with different data, I have to delete the original word template and replace it with a master copy, as the bookmarks are deleted.
Is there a way of getting around this? I.e. not deleting the bookmarks?
Bookmarks