Peter Karlström
2007-10-12 07:39:01 UTC
Hi
I have a problem with watermarks in documents.
I have developed a COM-Addin for Word XP/2003 with a lot of functionality.
One of them is a customized watermark in the documents.
The user opens a dialogue where they choose one of 3 types of text for the
watermark, or to have no watermark.
When they click OK the watermark is created on page 2 and forward.
Nothing attaches to the first page.
In the code below I have tested both wdHeaderFooterFirstPage and
wdHeaderFooterPrimary with the same result. If I use both I get doubled
watermark on page 2 and forward.
What have I made wrong, or is this a bug?
Thanks in advance
+++++++++ START CODE +++++++++++++++
Private Sub cmdOK_Click()
Dim WMText As String 'Text for watermark
Dim AcDoc As Word.Document 'Active document
Dim sec As Word.Section 'Section
Dim hfPri As Word.HeaderFooter 'Primary header/footer
Dim hfFrst As Word.HeaderFooter 'First header/footer
Dim shp As Word.Shape 'Watermark shape
Dim WMCount As Integer 'Nbr of watermarks
Dim cm As ADODB.Command 'ADODB Command
Dim rs As ADODB.Recordset 'ADODB Recordset
'Mark position in document
wrdApp.Windows(ActiveDoc).Document.Bookmarks.Add ("tmpAuto")
'Delete any existing watermark
Set AcDoc = wrdApp.Windows(ActiveDoc).Document
For Each sec In AcDoc.Sections
Set hfPri = sec.Headers(wdHeaderFooterPrimary)
For Each shp In hfPri.Shapes
If Left(shp.Name, 16) = "SKBMallWatermark" Then
shp.Delete
End If
Next
Set hfFrst = sec.Headers(wdHeaderFooterFirstPage)
For Each shp In hfFrst.Shapes
If Left(shp.Name, 16) = "SKBMallWatermark" Then
shp.Delete
End If
Next
Next
Set AcDoc = Nothing
Set hfPri = Nothing
Set hfFrst = Nothing
'Get user choice of watermark
Select Case selWatermark
Case 0 'Security class
WMText = lblWatermark.Caption
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkType") = "0"
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkText") = WMText
Case 1 'Database text
If lstWatermark.SelCount = 0 Then
MsgBox "You must choose a text for watermark in the list.",
vbOKOnly, App.ProductName & "Ver: " & App.Major & "." & App.Minor & "." &
App.Revision
Exit Sub
End If
'Initiera databaskoppling
Set cm = CreateObject("ADODB.Command")
Set rs = CreateObject("ADODB.Recordset")
cm.CommandType = 1
Set cm.ActiveConnection = cn
'Get watermark from database
cm.CommandText = "SELECT * from tblWWatermark Where fldID = " &
lstWatermark.ItemData(lstWatermark.ListIndex)
rs.Open cm, , adOpenDynamic, adLockReadOnly
If Not rs.BOF And Not rs.EOF Then
Select Case
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_Språk")
Case "0"
WMText = Trim(rs("fldHeadingSve"))
Case "1"
WMText = Trim(rs("fldHeadingEng"))
End Select
Else
WMText = lstWatermark.Text
End If
rs.Close
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkType") = "1"
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkText") = WMText
Set cm = Nothing
Set rs = Nothing
Case 2 'Free text
If Trim(txtWatermark.Text) = "" Then
MsgBox "You must write a text for watermark!", vbOKOnly,
App.ProductName & "Ver: " & App.Major & "." & App.Minor & "." & App.Revision
txtWatermark.SetFocus
Exit Sub
End If
WMText = txtWatermark.Text
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkType") = "2"
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkText") = WMText
Case 3 'No watermark
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkType") = "3"
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkText") = ""
GoTo noWM
End Select
'Add watermark to all parts of the document
Set AcDoc = wrdApp.Windows(ActiveDoc).Document
WMCount = 1
For Each sec In AcDoc.Sections
Set hfFrst = sec.Headers(wdHeaderFooterFirstPage)
Set shp = hfFrst.Shapes.AddTextEffect(PowerPlusWaterMarkObject1,
WMText, "Times New Roman", 66, False, False, 0, 0)
With shp
.Name = "SKBMallWatermark" & CStr(WMCount)
.TextEffect.NormalizedHeight = False
.Line.Visible = False
.Fill.Visible = True
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Fill.Transparency = 0.5
.Rotation = 315
.LockAspectRatio = True
.Height = CentimetersToPoints(2.65)
.Width = CentimetersToPoints(13.33)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Left = CentimetersToPoints(2)
.Top = CentimetersToPoints(13.33)
WMCount = WMCount + 1
End With
Set hfFrst = Nothing
Set shp = Nothing
Next
Set AcDoc = Nothing
noWM:
wrdApp.Windows(ActiveDoc).Document.Bookmarks("tmpAuto").Select
wrdApp.Windows(ActiveDoc).Document.Bookmarks("tmpAuto").Delete
Unload Me
End Sub
+++++++++ END CODE +++++++++++++++
I have a problem with watermarks in documents.
I have developed a COM-Addin for Word XP/2003 with a lot of functionality.
One of them is a customized watermark in the documents.
The user opens a dialogue where they choose one of 3 types of text for the
watermark, or to have no watermark.
When they click OK the watermark is created on page 2 and forward.
Nothing attaches to the first page.
In the code below I have tested both wdHeaderFooterFirstPage and
wdHeaderFooterPrimary with the same result. If I use both I get doubled
watermark on page 2 and forward.
What have I made wrong, or is this a bug?
Thanks in advance
+++++++++ START CODE +++++++++++++++
Private Sub cmdOK_Click()
Dim WMText As String 'Text for watermark
Dim AcDoc As Word.Document 'Active document
Dim sec As Word.Section 'Section
Dim hfPri As Word.HeaderFooter 'Primary header/footer
Dim hfFrst As Word.HeaderFooter 'First header/footer
Dim shp As Word.Shape 'Watermark shape
Dim WMCount As Integer 'Nbr of watermarks
Dim cm As ADODB.Command 'ADODB Command
Dim rs As ADODB.Recordset 'ADODB Recordset
'Mark position in document
wrdApp.Windows(ActiveDoc).Document.Bookmarks.Add ("tmpAuto")
'Delete any existing watermark
Set AcDoc = wrdApp.Windows(ActiveDoc).Document
For Each sec In AcDoc.Sections
Set hfPri = sec.Headers(wdHeaderFooterPrimary)
For Each shp In hfPri.Shapes
If Left(shp.Name, 16) = "SKBMallWatermark" Then
shp.Delete
End If
Next
Set hfFrst = sec.Headers(wdHeaderFooterFirstPage)
For Each shp In hfFrst.Shapes
If Left(shp.Name, 16) = "SKBMallWatermark" Then
shp.Delete
End If
Next
Next
Set AcDoc = Nothing
Set hfPri = Nothing
Set hfFrst = Nothing
'Get user choice of watermark
Select Case selWatermark
Case 0 'Security class
WMText = lblWatermark.Caption
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkType") = "0"
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkText") = WMText
Case 1 'Database text
If lstWatermark.SelCount = 0 Then
MsgBox "You must choose a text for watermark in the list.",
vbOKOnly, App.ProductName & "Ver: " & App.Major & "." & App.Minor & "." &
App.Revision
Exit Sub
End If
'Initiera databaskoppling
Set cm = CreateObject("ADODB.Command")
Set rs = CreateObject("ADODB.Recordset")
cm.CommandType = 1
Set cm.ActiveConnection = cn
'Get watermark from database
cm.CommandText = "SELECT * from tblWWatermark Where fldID = " &
lstWatermark.ItemData(lstWatermark.ListIndex)
rs.Open cm, , adOpenDynamic, adLockReadOnly
If Not rs.BOF And Not rs.EOF Then
Select Case
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_Språk")
Case "0"
WMText = Trim(rs("fldHeadingSve"))
Case "1"
WMText = Trim(rs("fldHeadingEng"))
End Select
Else
WMText = lstWatermark.Text
End If
rs.Close
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkType") = "1"
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkText") = WMText
Set cm = Nothing
Set rs = Nothing
Case 2 'Free text
If Trim(txtWatermark.Text) = "" Then
MsgBox "You must write a text for watermark!", vbOKOnly,
App.ProductName & "Ver: " & App.Major & "." & App.Minor & "." & App.Revision
txtWatermark.SetFocus
Exit Sub
End If
WMText = txtWatermark.Text
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkType") = "2"
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkText") = WMText
Case 3 'No watermark
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkType") = "3"
wrdApp.Windows(ActiveDoc).Document.CustomDocumentProperties("su_WatermarkText") = ""
GoTo noWM
End Select
'Add watermark to all parts of the document
Set AcDoc = wrdApp.Windows(ActiveDoc).Document
WMCount = 1
For Each sec In AcDoc.Sections
Set hfFrst = sec.Headers(wdHeaderFooterFirstPage)
Set shp = hfFrst.Shapes.AddTextEffect(PowerPlusWaterMarkObject1,
WMText, "Times New Roman", 66, False, False, 0, 0)
With shp
.Name = "SKBMallWatermark" & CStr(WMCount)
.TextEffect.NormalizedHeight = False
.Line.Visible = False
.Fill.Visible = True
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Fill.Transparency = 0.5
.Rotation = 315
.LockAspectRatio = True
.Height = CentimetersToPoints(2.65)
.Width = CentimetersToPoints(13.33)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapNone
.WrapFormat.Type = 3
.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Left = CentimetersToPoints(2)
.Top = CentimetersToPoints(13.33)
WMCount = WMCount + 1
End With
Set hfFrst = Nothing
Set shp = Nothing
Next
Set AcDoc = Nothing
noWM:
wrdApp.Windows(ActiveDoc).Document.Bookmarks("tmpAuto").Select
wrdApp.Windows(ActiveDoc).Document.Bookmarks("tmpAuto").Delete
Unload Me
End Sub
+++++++++ END CODE +++++++++++++++
--
Peter Karlström
Midrange AB
Sweden
Peter Karlström
Midrange AB
Sweden