Display watermark on second page of word document vba (1 Viewer)

[aman]

Hi All

There are two pages in a word document. All the pages have same headers as attached in word document "Capita.doc". I want to display that header on just first page and on second one page, I want to display watermark stored in "J:\PAP107.jpg". The following code displays same watermark on all the pages i.e "J:\PAP107.jpg" but I want to keep the header as in the attached word document on first page only and display watermark stored in "J:\PAP107.jpg" on second page Can anyone please amend the code accordingly?

Private Sub CmdPrint_Click()
 Call WordSetupQA("C:\CAPITA.dot", "J:\PAP107.jpg", Format(DateSerial(ComboBox4, ComboBox3, ComboBox2), "mm/dd/yyyy"), pno)
End Sub

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:\System1.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

 

[aman]

Hi Guys

I just want to amend the code so that the watermark appears only on the second page of the word document.

I hope any of Forum Gurus can help me in this.

Thanks