Option Explicit
Dim Doc As Document

Sub BD_CreateFile(control As IRibbonControl)
    On Error GoTo Error_Trap
    Dim LogoPath As String, ColPath As String, DocName As String
    
    LogoPath = "?"
    ColPath = "?"
    Set Doc = ActiveDocument
    DocName = Replace(Doc.Name, ".BIL", "")
 
    Call BD_RemoveExistingImages
    Call BD_AddLogo(LogoPath)
    Call BD_CreateDuplicate
    Call BD_SaveDuplicate(ColPath, DocName)
    Exit Sub
    
Error_Trap:
    MsgBox "Error in Create file code" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf, , "ERROR!"
    End
End Sub

Private Sub BD_RemoveExistingImages()
    On Error GoTo Error_Trap
    Dim mySection As Section
    Dim myHF As HeaderFooter
    Dim i As Long
    
    With Doc
        For Each mySection In .Sections()
            For Each myHF In mySection.Headers
                With myHF.Range
                    ' just in case there is more than one image
                    Do While .InlineShapes.Count > 0
                        .InlineShapes(1).Delete
                    Loop
                    For i = .ShapeRange.Count To 1 Step -1
                        With .ShapeRange(i)
                            If InStr(.Name, "WaterMark") > 0 Then .Delete
                        End With
                    Next
                End With
            Next
            For Each myHF In mySection.Footers
                With myHF.Range
                    For i = .ShapeRange.Count To 1 Step -1
                        With .ShapeRange(i)
                            If InStr(.Name, "WaterMark") > 0 Then .Delete
                        End With
                    Next
                End With
            Next
        Next
    End With
    Application.ScreenUpdating = True
    Exit Sub
    
Error_Trap:
    MsgBox "Error in BD_RemoveExistingImages code" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf, , "ERROR!"
End Sub

Private Sub BD_AddLogo(ByVal SrcePath As String)
    On Error GoTo Error_Trap
    Dim myHF As HeaderFooter
    
    With Doc.Sections.First
        If .Headers(wdHeaderFooterFirstPage).Exists Then
            Set myHF = .Headers(wdHeaderFooterFirstPage)
        ElseIf .Headers(wdHeaderFooterEvenPages).Exists Then
            Set myHF = .Headers(wdHeaderFooterEvenPages)
        Else
            Set myHF = .Headers(wdHeaderFooterPrimary)
        End If
        With myHF.Range
            .InlineShapes.AddPicture FileName:=SrcePath, LinkToFile:=False, SaveWithDocument:=True
            .ParagraphFormat.Alignment = wdAlignParagraphCenter
        End With
    End With
    Exit Sub
    
Error_Trap:
    MsgBox "Error in BD_AddLogo code" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf, , "ERROR!"
    End
End Sub

Private Sub BD_CreateDuplicate()
    On Error GoTo Error_Trap
    Dim myHF As HeaderFooter
    Dim Shp As Shape
    
    With Doc.Sections.First
        For Each myHF In .Headers
            If myHF.Exists Then
                Set Shp = HdFt.Shapes.AddTextEffect(msoTextEffect1, "Duplicate", "Arial", 1, False, False, 0, 0)
                With Shp
                    .Name = "DuplicateWaterMarkObject" & Format(Now, "YYMMDD") & Format(HdFt.Index, "00")
                    .Visible = False
                    .TextEffect.NormalizedHeight = False
                    .Line.Visible = False
                    .Fill.Visible = True
                    .Fill.Solid
                    .Fill.ForeColor.RGB = RGB(192, 192, 192)
                    .Fill.Transparency = 0.5
                    .Rotation = 315
                    .Height = InchesToPoints(2.42)
                    .Width = InchesToPoints(6.04)
                    .LockAspectRatio = True
                    .WrapFormat.AllowOverlap = True
                    .WrapFormat.Side = wdWrapNone
                    .WrapFormat.Type = wdWrapNone
                    .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
                    .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
                    .Left = wdShapeCenter
                    .Top = wdShapeCenter
                    .Visible = True
                End With
            End If
        Next
    End With
    Set Shp = Nothing
    Exit Sub
    
Error_Trap:
    MsgBox "Error in BD_CreateDuplicate code" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf, , "ERROR!"
    End
End Sub

Private Sub BD_SaveDuplicate(ByVal ColPath As String, ByVal DocName As String)
    On Error GoTo Error_Trap
         
    Doc.ExportAsFixedFormat OutputFileName:=ColPath & DocName, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, _
        OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
    Exit Sub
    
Error_Trap:
    MsgBox "Error in BD_SaveDuplicate code" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf, , "ERROR!"
    End
End Sub