Excel-Word Interop, Add Watermark Issue

gravanoc

Board Regular
Joined
Oct 20, 2015
Messages
127
I have a workbook that will convert multiple word documents at once into PDF format. I am combining two macros I found on the web to try and get them to open a word doc, place a watermark on the doc, and then export it as a PDF. It will do this once for each file in a folder that I specify in an Excel range, and put the resulting PDF at the path I specify in the range below that.

The problem I'm running into is trying to figure out how to classify a variable for a Word range selection within the context of Excel VBA. The error occurs at the line:
Code:
wordRg.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
    "DRAFT", "Arial", 1, False, False, 0, 0).Select
The code is below, any help is appreciated!

Code:
Sub Word_To_PDF()

Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")


Dim fso As New FileSystemObject
Dim fo As Folder
Dim f As File
Dim strWMName As String
Dim wordRg As Variant


Dim wb As Workbook
Dim n As Integer


Dim wordapp As New Word.Application
Dim worddoc As Word.Document


Set fo = fso.GetFolder(sh.Range("E2").Value)


For Each f In fo.Files
n = n + 1
Application.StatusBar = "Processing..." & n & "/" & fo.Files.Count


Set worddoc = wordapp.Documents.Open(f.Path)




On Error GoTo ErrHandler
     'selects all the sheets
    wordRg = worddoc.Sections(1).Range.Select
    strWMName = worddoc.Sections(1).Index
    worddoc.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
     'Change the text for your watermark here
    wordRg.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _
    "DRAFT", "Arial", 1, False, False, 0, 0).Select
    With wordRg.ShapeRange
         
        .Name = strWMName
        .TextEffect.NormalizedHeight = False
        .Line.Visible = False
         
        With .Fill
             
            .Visible = True
            .Solid
            .ForeColor.RGB = Gray
            .Transparency = 0.5
        End With
         
        .Rotation = 315
        .LockAspectRatio = True
        .Height = InchesToPoints(2.42)
        .Width = InchesToPoints(6.04)
         
        With .WrapFormat
            .AllowOverlap = True
            .Side = wdWrapNone
            .Type = 3
             
        End With
         
        .RelativeHorizontalPosition = wdRelativeVerticalPositionMargin
        .RelativeVerticalPosition = wdRelativeVerticalPositionMargin
         
         'If using Word 2000 you may need to comment the 2
         'lines above and uncomment the 2 below.
         
         '        .RelativeHorizontalPosition = wdRelativeVerticalPositionPage
         '        .RelativeVerticalPosition = wdRelativeVerticalPositionPage
         
        .Left = wdShapeCenter
        .Top = wdShapeCenter
    End With
     
    worddoc.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
     
    Exit Sub
     
ErrHandler:
    MsgBox "An error occured trying to insert the watermark." & Chr(13) & _
    "Error Number: " & Err.Number & Chr(13) & _
    "Decription: " & Err.Description, vbOKOnly + vbCritical, "Error"


worddoc.ExportAsFixedFormat sh.Range("E3").Value & Application.PathSeparator & VBA.Replace(f.Name, ".docx", ".pdf"), wdExportFormatPDF
worddoc.Close False
Next


Application.StatusBar = ""
MsgBox "Process Completed"


End Sub
 

Forum statistics

Threads
1,084,750
Messages
5,379,627
Members
401,616
Latest member
YoSquidly

Some videos you may like

This Week's Hot Topics

  • VBA code giving errors and stopping Excel
    Hello Experts, I have this code being used to loop through files in a file path, and copy specific data to another sheet. It is giving me several...
  • Disable MsgBox message
    Morning, I have a userform where if i leave a ComboBox empty i see a MsgBox warning me that i must enter an invoice number. It is this MsgBox i...
  • Macro Recorder into VBA, Copy Paste Data Filled Cells
    Hi Everyone, I have a macro recorder file that takes a selection of data, copies, then pastes into a new sheet on ("A2:B2") The issue is my...
  • Number format changes while pasting into a cell
    Hi, I am trying to paste a number 180204524303 from an email to an excel cell, however, whenever i try to do so , the the paste value appears as...
  • Collating data
    Hello all. Could someone please help. I am trying to pull all column data from multiple sheets (24 I total so far) into 1 master sheet without...
  • Sum Multiple Columns Based on Multiple Criteria
    I am trying to consolidate data by summing columns G through M based on material, plant, vendor, and fiscal year being identical. The period does...
Top