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:The code is below, any help is appreciated!
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:
wordRg.HeaderFooter.Shapes.AddTextEffect(msoTextEffect1, _ "DRAFT", "Arial", 1, False, False, 0, 0).Select
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