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