DRY in MS Word on a Mac

Lucky me had the opportunity to review & adopt 60+ HITRUST policies for HealthPrize this week. My friendly outside council delivered the policies as individual MS Word documents. So to make the process of inserting our logo, stamping the adoption date, and generally modifying the boilerplate to fit our needs I decided to apply a little macro magic. YMMV:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub HPTPolicies()
'
' HPTPolicies Macro
'
'
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.Text = "[[INSERT LOGO]]"
Do While .Execute
Selection.MoveRight
Selection.InlineShapes.AddPicture fileName:="/Volumes/mydrive/afolder/HPTlogo.png", LinkToFile:=False, SaveWithDocument:=True
Loop
End With
End With
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.Text = "[[INSERT LOGO]]"
Do While .Execute
Selection.Delete
Loop
End With
End With
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[Insert Title Appointed Person]"
.MatchCase = True
.Replacement.Text = "Chief Technology Officer"
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[Insert Title of `Appointed Person]"
.MatchCase = True
.Replacement.Text = "Chief Technology Officer"
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "ADD DATE"
.MatchCase = True
.Replacement.Text = "November 9, 2018"
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With ActiveDocument.ActiveWindow.View
.Type = wdPrintView
.Zoom.Percentage = 250
End With
End Sub

Share Comments