Check out Kite (free AI Coding Assistant) → Link
Buy Me a Coffee? Your support is much appreciated!
PayPal Me: https://www.paypal.me/jiejenn/5
Venmo: @Jie-Jenn
Source Code:
Option Explicit
Const CONFIDENTIAL_1 As String = "CONFIDENTIAL 1"
Const CONFIDENTIAL_2 As String = "CONFIDENTIAL 2"
Const DO_NOT_COPY_1 As String = "DO NOT COPY 1"
Const DO_NOT_COPY_2 As String = "DO NOT COPY 2"
Const BLOCK_TEMPLATE_DIR = "C:\Users\<user folder>\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Built-In Building Blocks.dotx"
Const BLOCK_TEMPLATE_DIR_CUSTOM = "C:\Users\<user folder>\AppData\Roaming\Microsoft\Document Building Blocks\1033\16\Building Blocks.dotx"
Sub Insert_Watermark()
Dim doc As Document
Dim wdSection As Section
Dim header As HeaderFooter
Dim rng As Range
Set doc = ThisDocument
For Each wdSection In doc.Sections
For Each header In wdSection.Headers
Set rng = header.Range
'Application.Templates(BLOCK_TEMPLATE_DIR).BuildingBlockEntries(DO_NOT_COPY_2).Insert rng
Application.Templates(BLOCK_TEMPLATE_DIR_CUSTOM).BuildingBlockEntries("Fall").Insert rng
Set rng = Nothing
Next header
Next wdSection
Set doc = Nothing
End Sub
Sub Remove_Watermark()
Dim doc As Document
Dim wdSection As Section
Dim header As HeaderFooter
Dim rng As Range
Dim shp As Shape
Set doc = ThisDocument
For Each wdSection In doc.Sections
For Each header In wdSection.Headers
Set rng = header.Range
For Each shp In rng.ShapeRange
If shp.Type = 13 Or shp.Type = 15 Then
shp.Delete
End If
Next shp
Set rng = Nothing
Next header
Next wdSection
Set doc = Nothing
End Sub
