Private Sub BD_RemoveExistingImages()
    On Error GoTo Error_Trap
    Dim ThisImage As InlineShape
    Dim mySection As Section
    Dim myHF As HeaderFooter
    Dim RngSel As Range
    
    With ActiveDocument
        Set RngSel = Selection.Range
        iView = ActiveWindow.View.Type
        For Each mySection In ActiveDocument.Sections()
            For Each myHF In mySection.Headers
                If myHF.Range.InlineShapes.Count > 0 Then
                    ' just in case there is more than one image
                    For Each ThisImage In myHF.Range.InlineShapes
                        ThisImage.Delete
                    Next
                End If
                myHF.Range.Select
                WordBasic.RemoveWatermark
            Next
            For Each myHF In mySection.Footers
                myHF.Range.Select
                WordBasic.RemoveWatermark
            Next
        Next
    End With
    
    RngSel.Select
    ActiveWindow.View.Type = iView
    Set RngSel = Nothing
    Application.ScreenUpdating = True
    
    Exit Sub
    
Error_Trap:
    MsgBox "Error in BD_RemoveExistingImages code" & vbCrLf & vbCrLf & Err.Number & " - " & Err.Description & vbCrLf & vbCrLf, , "ERROR!"
    End
End Sub
Private Sub BD_AddLogo(ByVal SrcePath As String)
    On Error GoTo Error_Trap
    
    Dim PecentSize As Integer
    Dim SHP As InlineShape
    PercentSize = 21
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
         
    Set SHP = Selection.InlineShapes.AddPicture(FileName:=SrcePath, _
                                LinkToFile:=False, _
                                SaveWithDocument:=True)
    'SHP.ScaleHeight = PercentSize
    'SHP.ScaleWidth = PercentSize
        
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    
    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
    With ActiveDocument
      With .Sections.First
        For Each HdFt In .Headers
            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
            .LockAspectRatio = True
            .Height = InchesToPoints(2.42)
            .Width = InchesToPoints(6.04)
            .WrapFormat.AllowOverlap = True
            .WrapFormat.Side = wdWrapNone
            .WrapFormat.Type = 3
            .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
            .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
            .Left = wdShapeCenter
            .Top = wdShapeCenter
            .Visible = True
          End With
          .Range.FormattedText.ShowAll = False
        Next
      End With
      With .ActiveWindow.View
        .ShowMarkupAreaHighlight = False
        .ShowComments = False
        .ShowRevisionsAndComments = False
      End With
      .FormattingShowClear = True
    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
         
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    ActiveDocument.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
Sub BD_CreateFile(control As IRibbonControl)
    On Error GoTo Error_Trap

    Dim LogoPath, ColPath, DocName
          
    Selection.HomeKey Unit:=wdStory
       
    DocName = Replace(ActiveDocument.Name, ".BIL", "")
    LogoPath = 'C:\Logo\'
    ColPath = 'C:\Files\'
 
    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