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?
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?
Code:
Private Sub CmdPrint_Click()
Call WordSetupQA("C:\CAPITA.dot", "J:\PAP107.jpg", Format(DateSerial(ComboBox4, ComboBox3, ComboBox2), "mm/dd/yyyy"), pno)
End Sub
Code:
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
Code:
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