Appropriate watermark on each letter of Printspool (1 Viewer)

aman

Registered User.
Local time
Yesterday, 21:24
Joined
Oct 16, 2008
Messages
1,250
Hi All

I am using Excel as a frontend and Access as a backend. Now in the main form the user types in all the information about a customer and press Save. Suppose he stores 10 customers details so I am using PrintSpool Number . For those 10 records the printspool number will be save so that when the user press Print button then all those 10 Word document letters will get printed off. This works absolutely fine. Now I want to do the following checks in the code while printing:

It will make it easier on the watermark issue as it changes the below

First check
IF AXAFRIENDS = FLC use NO WATERMARK and END conditional (do not do second or third check)
IF FALSE move to second check

Second check
IF Team = LTC use LTC and END conditional (do not do third check)
IF Team = WINTERTHUR use WLUKCAP4 and END conditional (do not do third check)
IF FALSE move to third check

Third check
IF AXAFRIENDS = FRIENDS use PAP107 and END conditionals
IF AXAFRIENDS = DM use PAPSLD and END conditionals

AXAFRIENDS is the name of the field and the above conditions will result in different watermarks for each customer letter. My code doesn't work as required. Suppose 10 records in Access table have same PrintSpool number (Textbox1) ,then it should check for each record the AXAFRIENDS field value and display appropriate watermark during PRINT. Please can anyone make neccessary changes to make it working as desired.

Code:
Private Sub CommandButton3_Click()
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=J:\System1.mdb;"
      Set rs = CreateObject("ADODB.Recordset")
      strsql = "select * from tblmaster where Printpoolno='" & TextBox1.value & "'"
      rs.Open strsql, cn
 
  Do While Not rs.EOF
       If rs.Fields("AXA/FRIENDS") = "FLC" Then
       Call Merge_FLC
 
        ElseIf rs.Fields("Team") = "LTC" Then
        Call Merge_LTC
 
        ElseIf rs.Fields("team") = "WINTERTHUR" Then
        Call Merge_WINTERTHUR
 
        ElseIf rs.Fields("AXA/FRIENDS") = "FRIENDS" Then
        Call Merge_PAP107
 
        ElseIf rs.Fields("AXA/FRIENDS") = "DM" Then
        Call Merge_PAPSLD
 
     End If
     rs.MoveNext
    Loop
    MsgBox "The letters have been printed off."
    rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub

Code:
Sub Merge_PAP107()
strworkbookname = "J:\WilliamsLea-AIMM\Critical Document Handling\ODH System.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
 
Call WordSetup("J:\test1\WFI Return Letter4.dot", "J:\System1\Test\PAP107.jpg", TextBox1.value, "FRIENDS")
 
 Exit Sub
 End If
 
If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
 Call WordSetup("J:\test1\CAPITA Return Letter5.dot", "J:\Test\PAP107.jpg", TextBox1.value, "FRIENDS")
 Exit Sub
 End If
 'Application.DisplayAlerts = True
 
End Sub
Sub Merge_PAPSLD()
strworkbookname = "J:\System1.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
 
Call WordSetup("J:\test1\WFI Return Letter4.dot", "J:\Test\PAPSLD.jpg", TextBox1.value, "DM")
 
 Exit Sub
 End If
 
 If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
 Call WordSetup("J:\test1\CAPITA Return Letter5.dot", "J:\Test\PAPSLD.jpg", TextBox1.value, "DM")
 Exit Sub
 End If
 'Application.DisplayAlerts = True
 
End Sub
Sub Merge_LTC()
strworkbookname = "J:\System1.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
 
Call WordSetup("J:\test1\WFI Return Letter4.dot", "J:\Test\LTC.jpg", TextBox1.value, "LTC")
 
 Exit Sub
 End If
 
 If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
 Call WordSetup("J:\test1\CAPITA Return Letter5.dot", "J:\Test\LTC.jpg", TextBox1.value, "LTC")
 Exit Sub
 End If
 'Application.DisplayAlerts = True
 
End Sub
Sub Merge_WINTERTHUR()
strworkbookname = "J:\System1.mdb"
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
 
Call WordSetup("J:\test1\WFI Return Letter4.dot", "J:\Test\WLUKCAP4.jpg", TextBox1.value, "WINTERTHUR")
 
 Exit Sub
 End If
 
 If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
 Call WordSetup("J:\test1\CAPITA Return Letter5.dot", "J:\Test\WLUKCAP4.jpg", TextBox1.value, "WINTERTHUR")
 Exit Sub
 End If
 
End Sub
Sub Merge_FLC()
Application.DisplayAlerts = False
strworkbookname = "J:\System1.mdb"
 
If UserForm6.Caption = "FL WFI RETURN LETTER" Or UserForm6.Caption = "AWL WFI RETURN LETTER" Then
With CreateObject("Word.Application").Documents.Add("J:\TEST WFI Return Letter1.dot").MailMerge
  .MainDocumentType = 0
  .Destination = 1
  .OpenDataSource _
            Name:=strworkbookname, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strworkbookname & ";Mode=Read", _
            sqlstatement:="SELECT tmpU.* FROM (SELECT * FROM tblmaster where Printpoolno='" & TextBox1 & "' and [AXA/FRIENDS]='FLC'" & _
                                  "UNION ALL SELECT * FROM tblmaster where Printpoolno='" & TextBox1 & "' and [AXA/FRIENDS]='FLC') tmpU ORDER BY tmpU.[PolicyNo];"
            'sqlstatement:="SELECT * FROM `tblmaster` where Printpoolno='" & TextBox1.value & "' and [AXA/FRIENDS]=FLC"
  .Execute
  .Execute
  .Parent.Close 0
 End With
  MsgBox "The letters have been printed off"
 Exit Sub
 End If
 
If UserForm6.Caption = "FL CAPITA CDR" Or UserForm6.Caption = "AWL CAPITA CDR" Then
 With CreateObject("Word.Application").Documents.Add("J:\CAPITA Return Letter5.dot").MailMerge
  .MainDocumentType = 0
  .Destination = 1
  .OpenDataSource _
            Name:=strworkbookname, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strworkbookname & ";Mode=Read", _
             sqlstatement:="SELECT tmpU.* FROM (SELECT * FROM tblmaster where Printpoolno='" & TextBox1 & "' and [AXA/FRIENDS]='FLC'" & _
                                  "UNION ALL SELECT * FROM tblmaster where Printpoolno='" & TextBox1 & "' and [AXA/FRIENDS]='FLC') tmpU ORDER BY tmpU.[PolicyNo];"
            'sqlstatement:="SELECT * FROM `tblmaster` where Printpoolno='" & TextBox1.value & "'"
  .Execute
   .Parent.Close 0
 End With
  MsgBox "The letters have been printed off"
 Exit Sub
 End If
 Application.DisplayAlerts = True
 
End Sub

Code:
Sub WordSetup(fnTemplate As String, fnBackGroundPic As String, txtbox As String, value As String)
On Error Resume Next
'MsgBox txtbox
Dim strworkbookname As String
strworkbookname = "J:\System1.mdb"
Set WordApp = GetObject(, "Word.Application")
 
If Err.Number <> 0 Then
'Launch a new instance of Word
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
InsertHeaderLogo (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 tmpU.* FROM (SELECT * FROM tblmaster where Printpoolno='" & txtbox & "' and [AXA/FRIENDS]='" & value & "'" & _
"UNION ALL SELECT * FROM tblmaster where Printpoolno='" & txtbox & "' and [AXA/FRIENDS]='" & value & "') tmpU ORDER BY tmpU.[PolicyNo];"
' sqlstatement:="SELECT * FROM `tblmaster` where Printpoolno='" & txtbox & "' and [AXA/FRIENDS]='" & value & "'"
'MsgBox sqlstatement
.Execute
'.Execute
.Parent.Close 0
End With
End If
 
ExitErrorHandler:
Exit Sub
ErrorHandler:
MsgBox "Error (" & Err.Number & ") : " & Err.Description & vbCrLf & vbCrLf & "Exiting procedure - WordSetUp", vbCritical
Resume ExitErrorHandler
End Sub
Public Function InsertHeaderLogo1(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

I hope anyone can see this code and help me to make it working.

Thanks
 
Last edited:

Rx_

Nothing In Moderation
Local time
Yesterday, 22:24
Joined
Oct 22, 2009
Messages
2,803
This looks very interesting, wish I had time to look into it more.
First glance: ("J:\test1\CAPITA Return Letter5.dot", ...
You are calling template with a watermark.
Can you set up a template for each watermark? Then call it?

I realize your application may have 100's of different water marks.
If you only have 10, then it might be worth creating the 10 and calling them with a select statement or a table with a DLookup.
If you plan to have 100's, then create a table with the Dot name and icon. It might be worth creating a automated maintence form to manage the creation and changes in the grpahics. By having a folder with pre-defined watermark templates, they could be opened and checked out for quality control.
 

spikepl

Eledittingent Beliped
Local time
Today, 06:24
Joined
Nov 3, 2010
Messages
6,142
A word of advice: you have not defined what your current problem with the code is. "Not working" says nothing.

I doubt very much that all the code you are showing is necessary to illustrate whatever issue you are having. But I can assure you it confuses the heck out of the reader.

Remove everything that is not related to the issue. Simplify the code so that fixing the issue in this code will tell you what to do with your own code. Above all, for the simplified code, define what the problem is: what do you want to happen, but do not forget to say what is happening instead.
 

aman

Registered User.
Local time
Yesterday, 21:24
Joined
Oct 16, 2008
Messages
1,250
Hi RX

In my project, I just need 4 watermarks and there are 10 different templates so as you said if I need a different template for each watermark then in that case there will be 40 templates with appropriate watermark.

Then should I call them separately ? will it be a better method?

Many Thanks
 
Last edited:

Rx_

Nothing In Moderation
Local time
Yesterday, 22:24
Joined
Oct 22, 2009
Messages
2,803
The contractors answer is "it depends".
My preference would be to build a table of Watermark symbols and table of Templates and use code to allow for some interface to associate something like company names with the combination of the two.
Just guessing that over time, things will change.

Another method might be to actually set up the 40 options on a network location, then in a table, store a short name and path to call for your code.

Both of these prevent the user from mucking around (changing) the desired effects.
As Spikepl noted, if you can list the general overview of the question, user audience, and desired results - it will help. If it is for one person, different solution than a database that 50 poeple use daily.
 

Users who are viewing this thread

Top Bottom