Security stamp
A client required sensitive documents to be marked in some way so that users would be aware of whether it was safe to pass them around or not. However, the documents come from formatted templates which have a lot of automatic information in the headers and footers. It was felt unlikely that the document users would be able to insert more information without disturbing the formatting, nor were they likely to be able to insert a watermark. Although they could be trained to, it was also felt that they were likely to forget to do it.
My proposed solution was to create a "userform" that pops-up when they create a new document, and asks if the document is sensitive or not. If it is, the macro would insert a watermark to that effect; and here's how we did it:
- Open the MS Word template that your documents will be based on (if you're using templates, make sure that it's the ".dot" document that you open, not ".doc").
- Press ALT and F11 to open the Visual Basic Editor (or select from the Tools | Macro menu).
- Make sure that your template is selected in the Project Pane.
- Select Insert UserForm from the toolbar or from the Insert menu.
- Edit the caption field (in the properties pane) to change the form title to "Document Security".
- Drag an OptionButton control onto the form.
- Change the Caption to "Protected".
- Drag another OptionButton control onto the form.
- Change the Caption to "Unprotected".
- Drag a CommandButton onto the form.
- Change the Caption to "Submit".
- Drag a Label control onto the form.
- Change the Caption to "Does this document need to be protected or not? Tick the option as required and click Submit.".
You now have a blank form to work with.
That's the form done. Next we need to add some code to make it do something when the Submit button is clicked. For the purposes of tidiness, we'll create a separate macro to insert the watermark and make that macro work if the option is selected.
- Double-click the Submit button.
-
The focus should be after the line "Private Sub CommandButton1_Click()", if not, select "CommandButton1" from the left drop-down list and "Click" from the right drop-down list.
- Enter the following text:
This will open the code page for the UserForm
If OptProtected = True Then
'If the "protected" option is selected
Application.Run MacroName:="InsertWaterMark"
'Calls the macro to insert the watermark
End If
If OptUnprotected = True Then
'If the unprotected option is selected
Application.Run MacroName:="RemoveWaterMark"
'Calls the macro to remove the watermark
End If
Application.ScreenUpdating = True
'Refreshes the screen
UserForm1.Hide
'Hides the UserForm
| Please note that the above code needs to be in between the "Private Sub CommandButton1_Click()" tag and the "End Sub" tag. I've also included the call to a macro to remove the watermark, which will come in handy later. |
Now we create the macro that inserts the watermark.
- Select Insert Module from the toolbar or from the Insert menu.
- On the Module Code page, enter the following text:
Option Explicit
Sub InsertWaterMark()
Dim strWMark As String
'defines a string to use in the macro
ActiveDocument.Sections(1).Range.Select
'selects all the sheets
strWMark = ActiveDocument.Sections(1).Index
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, "Protected Document", "Arial", 1, False, False, 0, 0).Select
'Defines the text for the watermark
With Selection.ShapeRange
.Name = strWMark
.TextEffect.NormalizedHeight = False
.Line.Visible = False
With .Fill
.Visible = True
.Solid
.ForeColor.RGB = Gray
.Transparency = 0.8
End With
.Rotation = 315
.LockAspectRatio = True
.Height = InchesToPoints(2.42)
.Width = InchesToPoints(6.04)
With .WrapFormat
.AllowOverlap = True
.Side = wdWrapNone
.Type = 3
'All of this formats the watermark
End With
.RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
.RelativeVerticalPosition = wdRelativeVerticalPositionMargin
.Left = wdShapeCenter
.Top = wdShapeCenter
End With
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Exit Sub
End Sub
Sub RemoveWaterMark()
Dim strWMark As String
ActiveDocument.Sections(1).Range.Select
strWMark = ActiveDocument.Sections(1).Index
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
Selection.HeaderFooter.Shapes(strWMark).Select
Selection.Delete
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Exit Sub
End Sub
Now we have a working UserForm that does what we need. Now we need to make that UserForm appear when users create new documents from the template.
The simplest solution, and one which particularly applies if you only want the UserForm to open with new documents based on this template, is to use the "Document_New()" solution below. However, it is possible to open up the UserForm if any new document is created. See the next section for instructions to do that.
- In the VBA Project window, double-click on "ThisDocument".
- On the code page, enter the following text:
- Save and close everything.
- Test your template by opening a new document and seeing if it works.
- Let your users know to use the new template.
Private Sub Document_New()
UserForm1.Show
End Sub
If you create a DocumentChange event and store it in an Addin, it can be triggered when any document is created, opened, closed or the focus changes from one document to another.
- Make sure that the code from the previous section is deleted or commented out (put a 'before each line).
- Select Insert Module from the toolbar or from the Insert menu.
- On the Module Code page, enter the following text:
- Select Insert Class Module from the toolbar or from the Insert menu.
- Rename the Class Module "ThisApplication".
- On the Class Module Code page, enter the following text:
- Save and close everything.
- Test your template by opening a new document and seeing if it works.
- Let your users know to use the new template.
Option Explicit
Dim oAppClass As New ThisApplication
Public oldNoOfOpenDocs As Long
Public FirstNewDoc As Boolean
Public Sub AutoExec()
Set oAppClass.oApp = Word.Application
oldNoOfOpenDocs = 0
FirstNewDoc = True
End Sub
Option Explicit
Public WithEvents oApp As Word.Application
Private Sub oApp_DocumentChange()
On Error GoTo ExitCode
Dim newNoOfOpenDocs As Long
Dim docAdded As Boolean
Dim docClosed As Boolean
newNoOfOpenDocs = Application.Documents.Count
If newNoOfOpenDocs > oldNoOfOpenDocs Then
docAdded = True
If ActiveDocument.Name = "Document1" And FirstNewDoc Then
FirstNewDoc = True
Else
FirstNewDoc = False
End If
oldNoOfOpenDocs = oldNoOfOpenDocs + 1
ElseIf oldNoOfOpenDocs > newNoOfOpenDocs Then
docClosed = True
FirstNewDoc = False
oldNoOfOpenDocs = oldNoOfOpenDocs - 1
End If
If docAdded Then
If Len(ActiveDocument.Path) = 0 Then
Call PsuedoAutoNew
Else
Call PsuedoAutoOpen
End If
ElseIf docClosed Then
Call PsuedoAutoClose
ElseIf FirstNewDoc Then
If Len(ActiveDocument.Path) = 0 Then
Call PsuedoAutoNew
Else
Call PsuedoAutoOpen
End If
Else
Call DocChangedFocus
End If
Exit Sub
ExitCode:
End Sub
Private Sub PsuedoAutoNew()
UserForm1.Show
End Sub
Private Sub PsuedoAutoOpen()
End Sub
Private Sub PsuedoAutoClose()
'Your code here
End Sub
Private Sub DocChangedFocus()
'Your code here
End Sub
| Please note that the above code includes options for opening and closing documents and changing focus. I've left that in just in case you find it useful. There is also a simpler method for users of Word 2000+, but this method will work just as well and will also cover Word 97 users. |
Well there it is, and it could've been done a little simpler, except that it would've made the next stage more difficult.
It was at this point that the client was so pleased, that they said they had thousands of existing documents, and can I make it do that when the existing ones are opened? but obviously only once, not every time they're opened.
So the task continues, click here to see the rest…
