Background image in word document vba (1 Viewer)

[aman]

Hi All
If I use the word template named "ABC.dot" as attached and write the following piece of code to print off the letters with different appropriate background , it works perfetcly fine:

Sub PrintLetters()
Application.DisplayAlerts = False
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim r As Long
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _
        "Data Source=C:\Documents and Settings\kaura2\Desktop\Quality Audit CDH\ODH System.mdb;"
      Set rs = CreateObject("ADODB.Recordset")
      strsql = "select * from tblmaster where Date1 = #" & Format(DateSerial(ComboBox4, ComboBox3, ComboBox2), "mm/dd/yyyy") & "# and choice='FL CAPITA CDR' and QAPass <> null"
      rs.Open strsql, cn
'MsgBox rs.Fields(0).value
'Exit Sub
   Do While Not rs.EOF
   
            If rs.Fields("AXA/FRIENDS") = "FRIENDS" Then
            Call Merge_PAP107(rs("ID"))
                
            ElseIf rs.Fields("AXA/FRIENDS") = "DM" Then
            Call Merge_PAPSLD(rs("ID"))
         
      
        End If
    rs.MoveNext
    Loop
    MsgBox "The letters have been printed off."
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.DisplayAlerts = True
End Sub

Sub Merge_PAP107(pno As String)
strworkbookname = "C:\Documents and Settings\kaura2\Desktop\Quality Audit CDH\ODH System.mdb"

Call WordSetupQA("C:\Documents and Settings\kaura2\Desktop\Quality Audit CDH\CAPITA.dot", "J:\PAP107.jpg", Format(DateSerial(ComboBox4, ComboBox3, ComboBox2), "mm/dd/yyyy"), pno)
End Sub

Sub Merge_PAPSLD(pno As String)
strworkbookname = "C:\Documents and Settings\kaura2\Desktop\Quality Audit CDH\ODH System.mdb"
Call WordSetupQA("C:\Documents and Settings\kaura2\Desktop\Quality Audit CDH\CAPITA.dot", "J:\PAPSLD.jpg", Format(DateSerial(ComboBox4, ComboBox3, ComboBox2), "mm/dd/yyyy"), pno)
End Sub

Option Explicit
Public WordApp As Word.Application
Public WordDoc As Word.Document
Public WordLogo As Word.InlineShape
Sub WordSetupQA(fnTemplate As String, fnBackGroundPic As String, b As Date, a As String)
    On Error Resume Next
    'MsgBox txtbox
    Application.DisplayAlerts = False
    Dim strworkbookname As String
    strworkbookname = "C:\Documents and Settings\kaura2\Desktop\Quality Audit CDH\ODH System.mdb"
    Set WordApp = GetObject(, "Word.Application")
    
    If Err.Number <> 0 Then
           Err.clear
        On Error GoTo ErrorHandler
        Set WordApp = CreateObject("Word.Application") 'New Word.Application
    End If
    WordApp.Documents.Add (fnTemplate)
    Set WordDoc = WordApp.ActiveDocument
    'WordApp.Visible = True
    InsertHeaderLogoQA (fnBackGroundPic)
   
  With WordDoc.MailMerge
  .MainDocumentType = 0
  .Destination = 1
  .OpenDataSource _
            Name:=strworkbookname, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strworkbookname & ";Mode=Read", _
            sqlstatement:="SELECT * FROM `tblmaster` where Date1=#" & Format(b, "mm/dd/yyyy") & "# and [id]=" & a & ""
            'MsgBox sqlstatement
 
  .Execute
 ' End If
  .Parent.Close 0
  End With
  Application.DisplayAlerts = True
 
ExitErrorHandler:
    Exit Sub
ErrorHandler:
    MsgBox "Error (" & Err.Number & ") : " & Err.Description & vbCrLf & vbCrLf & "Exiting procedure - WordSetUp", vbCritical
    Resume ExitErrorHandler
End Sub

Public Function InsertHeaderLogoQA(fnBackGroundPic As String)
Dim Shp As Word.Shape
        On Error Resume Next
        'Background Picture
        If Not fnBackGroundPic = "" Then
        Set WordLogo = WordApp.ActiveDocument.Bookmarks("BackGroundPicture").Range.InlineShapes.AddPicture(Filename:=fnBackGroundPic, LinkToFile:=False, SaveWithDocument:=True)
            With WordLogo
                .ConvertToShape
                .Range.ShapeRange.Fill.Visible = msoFalse
                .Range.ShapeRange.Fill.Solid
                .Range.ShapeRange.Fill.Transparency = 0#
                .Range.ShapeRange.Line.Weight = 0.75
                .Range.ShapeRange.Line.DashStyle = msoLineSolid
                .Range.ShapeRange.Line.Style = msoLineSingle
                .Range.ShapeRange.Line.Transparency = 0#
                .Range.ShapeRange.Line.Visible = msoFalse
                .Range.ShapeRange.LockAspectRatio = msoFalse
                .Range.ShapeRange.Rotation = 0#
                .Range.ShapeRange.PictureFormat.Brightness = 0.4
                .Range.ShapeRange.PictureFormat.Contrast = 0.8
                .Range.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
                .Range.ShapeRange.PictureFormat.CropLeft = 0#
                .Range.ShapeRange.PictureFormat.CropRight = 0#
                .Range.ShapeRange.PictureFormat.CropTop = 0#
                .Range.ShapeRange.PictureFormat.CropBottom = 0#
                .Range.ShapeRange.Left = 90.4
                .Range.ShapeRange.Top = 135.45
                .Range.ShapeRange.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
                .Range.ShapeRange.RelativeVerticalPosition = wdRelativeVerticalPositionPage
                .Range.ShapeRange.RelativeHorizontalSize = wdRelativeHorizontalSizePage
                .Range.ShapeRange.RelativeVerticalSize = wdRelativeVerticalSizePage
                .Range.ShapeRange.Left = wdShapeLeft
                .Range.ShapeRange.LeftRelative = wdShapePositionRelativeNone
                .Range.ShapeRange.Top = wdShapeTop
                .Range.ShapeRange.TopRelative = wdShapePositionRelativeNone
                .Range.ShapeRange.WidthRelative = wdShapeSizeRelativeNone
                .Range.ShapeRange.HeightRelative = wdShapeSizeRelativeNone
                .Range.ShapeRange.LockAnchor = False
                .Range.ShapeRange.LayoutInCell = True
                .Range.ShapeRange.WrapFormat.AllowOverlap = True
                .Range.ShapeRange.WrapFormat.Side = wdWrapBoth
                .Range.ShapeRange.WrapFormat.DistanceTop = WordApp.CentimetersToPoints(0)
                .Range.ShapeRange.WrapFormat.DistanceBottom = WordApp.CentimetersToPoints(-1)
                .Range.ShapeRange.WrapFormat.DistanceLeft = WordApp.CentimetersToPoints(0.32)
                .Range.ShapeRange.WrapFormat.DistanceRight = WordApp.CentimetersToPoints(0.32)
                '.Range.ShapeRange.WrapFormat.Type = wdWrapBehind
                .Range.ShapeRange.WrapFormat.AllowOverlap = True
                .Range.ShapeRange.WrapFormat.Side = wdWrapBoth
                .Range.ShapeRange.WrapFormat.Type = 3
                .Range.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
                .Range.ShapeRange.ZOrder 5
                .Range.ShapeRange.Height = 850
                .Range.ShapeRange.Width = 595.3
            End With
        End If
End Function

But if I combine two templates together in one template as attached "Capita.dot" then it doesn't display background picture at all in any of the cases. I am using the same piece of code but the background image is not displaying. The background image shows logos for each letter like For capita letters , the logo will be capita . For Friends Life letters the logo background will be different.
Any help will be much appriciated.
Thanks

 

[Rx_]

That is a very amazing project you have going. I hope you can share more of this with the forum. There have been other questions about this before.

I am just wondering if putting a Watermark on the background would work for you?
Your project seems to need a different watermark for each group of pages for the mailing list.
A while back I looked at how to do this and kept this site bookmarked:
http://answers.microsoft.com/en-us/...ach-page/7f73b736-5da3-4eea-9af1-4629addcd4b4
The project requirements changed so I didn't have an opportunity to update my Word skills.