Adding watermark in word using Access VbA (1 Viewer)

[contractor]

Aman, I hove tried it out on the db that i previously posted and it works fine on my word document (template.docx).

I have no idea what the reason can be....

Contractor

 

[aman]

Hi, Please see attached my database and word document. Could you please try to figure out now why its not working?

Thanks

 

[contractor]

Aman,

I have Check your db, and apparently You didn't declare the following on your module :

Option Compare Database
Option Explicit
Public WordApp As Word.Application
Public WordDoc As Word.Document
Public WordLogo As Word.InlineShape

The code works fine after adding the declarations on your module.

PS :Always use "Option Explicit"

Success

Contractor

 

[contractor]

Aman,
also add reference Microsoft Office XX Object Lib or you will het error on the line "msotrue"

Contractor

 

[aman]

Contractor, I added the declaration and reference. After this when I tried to run the code then it gace me a compiler error (Variable not defined) at "wdWrapBehind" in function "Public Function InsertHeaderLogo(fnBackGroundPic As String)"

Please help me in this.

Thabnks again.

 

[contractor]

Aman,

This problem occurs because you are using Access 2003,

Change the following code on your module with this :

Public Function InsertHeaderLogo(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
                .LockAspectRatio = msoTrue
                '.Range.ShapeRange.WrapFormat.Type = wdWrapBehind
                .Range.ShapeRange.WrapFormat.AllowOverlap = True
                .Range.ShapeRange.WrapFormat.Side = wdWrapBoth
                .Range.ShapeRange.WrapFormat.Type = 3
                .PictureFormat.ColorType = msoPictureGrayscale
                'Debug.Print .Title
                .PictureFormat.Contrast = 0.4
                .PictureFormat.Brightness = 0.8
                .Width = 538.58
                .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Range.ParagraphFormat.Alignment = wdAlignParagraphJustifyLow
                .Range.ParagraphFormat.LeftIndent = WordApp.CentimetersToPoints(-1#)
                .Range.ShapeRange.Align msoAlignCenters, True
                .Range.ShapeRange.Align msoAlignMiddles, True
                .Range.ParagraphFormat.SpaceBeforeAuto = False
                .Range.ParagraphFormat.SpaceAfterAuto = False
            End With
            Else
            MsgBox "hELLO"
    End If
End Function

Contractor

 

[aman]

Contractor, I changed the code and run the code too . It opens up a word document but doesn't display the watermark on it. Please see attached the word document and database and also picture(watermark).

Thanks

 

[contractor]

Aman,

Change this : "C:\Documents and Settings\Amanpreet Kaur\Desktop\PAPSLD.JPEG"
to : "C:\Documents and Settings\Amanpreet Kaur\Desktop\PAPSLD.JPG"

let me now if its working

 

[aman]

Wowwwwwww gr8 job. Its working perfectly. Many thanks for your help.

 

[contractor]

Aman,

it was a difficult birth, but it ended well,

i'am glad to help if i can...

Don(t forget to push the thank button

Contractor

 

[aman]

Hi Contractor. Sorry to bother u again. Just spoke to my manager and he said he wants the same code in Excel/vba and not in Access/vba. Is there any way we can make the code working in Excel/vba.

Thanks a lot for your help so far.

 

[aman]

Thanks Contractor. I just added relevant references in Excel/vba code and the same code perfectly fine in Excel too.

Thanks sooooooooooo much for your help.

 

[contractor]

Aman,

Glad it workt to with excel/vba....

Success

Contractor

 

[aman]

Hi contractor,

I am back again.
The watermark image is currently too small . When I take a look at the printout. we will need to arrange for the watermark image to be scaled to 100%.

Can you please help me in this?

Regards,

 

[contractor]

Hi aman,

Which type of paper size are we talking, A4, us Letter,.... ?

 

[aman]

Its the A4 paper size.

Thanks

 

[contractor]

Hi Aman,

Sorry for late response,

Public Function InsertHeaderLogo(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 = msoPictureGrayscale
                .Range.ShapeRange.ZOrder 5
                .Range.ShapeRange.Height = 850
                .Range.ShapeRange.Width = 595.3
            End With
        End If
End Function

The picture that you earlier had provided has Aspect Ratio problems, so I could not lock it.

But i presume that the picture you provided is not the original due it has markers for a press room.

So if the original Picture has a better Aspect Ratio then you only have to change the following line :

 .Range.ShapeRange.LockAspectRatio = msoFalse
To :
 .Range.ShapeRange.LockAspectRatio = msoTrue

I hope this was clear.

success

 

[aman]

Thanks Contractor for your great help.

 

[aman]

Hi Contractor

Sorry I am back again. Actually the watermark code works fine but when the multiple users press print at the same time and they use same printer then their copies of the letters gets mixed up and then they need to spend some time to sort out their letters. Is there any way we can print initials of the usernames at the bottom of each letter that gets printed off and this way it would be easier for them to sort out the letters.

Thanks

 

[contractor]

aman,

add a new bookmark called "UserName" in your word document, the best place would be on the bottom section.

then

Place this code in a module :

Public Sub InsertBookMarkText(strBookmark As String, varText As Variant)
On Error GoTo ErrorHandler
    Dim BookmarkRange As Range

    Set BookmarkRange = WordDoc.Bookmarks(strBookmark).Range

    BookmarkRange.Text = varText & ""
    WordDoc.Bookmarks.Add strBookmark, BookmarkRange
    'BookmarkRange.Select
    
Exit_ErrorHandler:
    Exit Sub

ErrorHandler:
    Select Case Err.Number
        Case 4605 'this method or property is not available because the object is empty
            Resume Next
        Case 5941, 6028 ' member does not exist/the range cannot be deleted
            MsgBox "Bookmark {" & strBookmark & "} There is a mapping error with this document.  Please contact your administrator.", vbOKOnly
            Resume Next
        Case 91     'object variable not set
            Resume Next
        Case 4218   'type mismatch
            Resume Next
        Case Else
            msgbox Err.Number & vbcrlf & Err.Description & vbcrlf & vbcrlf "Proc: InsertBookMarkText()",vbInformation + vbOKOnly,"Error"
            Resume Exit_ErrorHandler
        End Select
            Resume Exit_ErrorHandler
End Sub

and place this code on the bottom of Sub : WordSetup()

InsertBookMarkText "UserName",  Environ("username")