VBA Runtime Error 462

[Jasesair]

I've read of this 462 error in other threads, with folk suggesting the sheet etc hasn't been qualified sufficiently. My project is copying ranges from Excel into Word, and this 462 error, which seems to happen the second time it's run, is happening within this section:

 With WordApp.ActiveDocument.PageSetup
 .Orientation = wdOrientLandscape
 .TopMargin = CentimetersToPoints(0.5)
 .BottomMargin = CentimetersToPoints(1)
 .LeftMargin = CentimetersToPoints(1)
 .RightMargin = CentimetersToPoints(1)
  End With

Debug suggests my error is here:
.TopMargin = CentimetersToPoints(0.5)

Does anyone know how to correct this? I thought everything would be right having qualified with ActiveDocument

Any help would be very much appreciated.

 

[mole999]

maybe be something, what language is the software sometimes dot should be comma

 

[Jasesair]

That'd be like trying to find a needle in a haystack. Suggestions elsewhere suggest better naming of the sheet etc. I'm not sure what that would look like in my case.

 

[mole999]

you showed a dot in the vba, is that what the system is expecting, does using 1 on its own generate the same error

 

[RoryA]

I suspect that the issue is actually with an unqualified object reference somewhere else in the code. If you can't paste it all here, go through and make sure you don't have any unqualified calls to Word objects other than the top level WordApp.

 

[Jasesair]

I'm not 100% sure what you mean by top level WordApp.

I hope this isn't too large to paste in here. I've tried to highlight where the debug is sending me.

Sub CreateMarkingGuide1() 'UPDATE

Application.ScreenUpdating = False
Sheets("Marking Guides (2)").Visible = True

Call CopyPasteMGuide_Y3U1 'UPDATE
Call ExcelRangeToWordv21 'UPDATE

Sheets("Marking Guides (2)").Visible = False

End Sub

Sub FilterOutBlanks1() 'UPDATE

ActiveWorkbook.Sheets("Marking Guides (2)").Range("Y3U1").AutoFilter Field:=(2), Criteria1:="<>" 'UPDATE

End Sub
Sub CopyPasteMGuide_Y3U1() 'UPDATE

ThisWorkbook.Worksheets("Marking Guides (2)").Select
Range("a9:cl25").ClearContents 'UPDATE

Call FilterOutBlanks1 'UPDATE

Range("b35:j52").Copy 'UPDATE
Range("b9").PasteSpecial Paste:=xlPasteValues 'UPDATE
Range("a9:a25").EntireRow.AutoFit 'UPDATE

Range("Y3U1").AutoFilter Field:=(2) 'UPDATE
Range("d9:d25").ClearContents 'UPDATE

End Sub

Sub ExcelRangeToWordv21() 'UPDATE

Dim tbl As Excel.Range
Dim WordApp As Word.Application
Dim myDoc As Word.Document
Dim WordTable As Word.Table

'Optimize Code
Application.ScreenUpdating = False
  Application.EnableEvents = False

'Copy Range from Excel
Set tbl = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b9:j25").SpecialCells(xlCellTypeConstants, 3)
Set Header = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b1:j7") 'UPDATE
Set Footer = ThisWorkbook.Worksheets("Marking Guides (2)").Range("b27:j28") 'UPDATE
Set Sheet = ThisWorkbook.Worksheets("Marking Guides (2)")
'If MS Word is already open
 ' Set WordApp = GetObject("Word.Application")

'If MS Word is not already open then open MS Word
  If WordApp Is Nothing Then Set WordApp = CreateObject("Word.Application")

'Make MS Word Visible and Active
WordApp.Visible = True

'Create a New Document
  Set myDoc = WordApp.Documents.Add

'Copy Header range
Sheet.Select
Header.Select
Selection.Copy
  Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

'Copy Footer range
Sheet.Select
  Footer.Select

'Set Word Margins
With WordApp.ActiveDocument.PageSetup
.Orientation = wdOrientLandscape
[B][COLOR=rgb(65, 168, 95)].TopMargin = CentimetersToPoints(0.5)[/COLOR][/B]
.BottomMargin = CentimetersToPoints(1)
.LeftMargin = CentimetersToPoints(1)
.RightMargin = CentimetersToPoints(1)
End With


'Change the view to header & footer
If WordApp.ActiveWindow.View.SplitSpecial <> wdPaneNone Then
WordApp.ActiveWindow.Panes(2).Close
End If

'Select the Header range and paste as image
ThisWorkbook.Worksheets("Marking Guides (2)").Range("b1:j7").Copy 'UPDATE
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
WordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, _
        Placement:=wdInLine, DisplayAsIcon:=False

'Select the Footer range and paste as image
ThisWorkbook.Worksheets("Marking Guides (2)").Range("b27:j28").Copy 'UPDATE
WordApp.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
WordApp.Selection.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
WordApp.Selection.Borders(wdBorderTop).LineWidth = wdLineWidth150pt
WordApp.Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
WordApp.Selection.Borders(wdBorderBottom).LineWidth = wdLineWidth150pt
WordApp.Selection.InsertAfter ("Comments:")
WordApp.Selection.InsertAfter Chr(13)

WordApp.ActiveWindow.View.Type = wdNormalView
WordApp.ActiveWindow.View.Type = wdPrintView


'Copy Excel Table range
Sheet.Select
tbl.Copy

'Paste Table into Word
myDoc.Content.Paste



'Autofit Table so it fits inside Word Document
Set WordTable = myDoc.Tables(1)
WordTable.AutoFitBehavior (wdAutoFitWindow)
WordTable.RightPadding = CentimetersToPoints(0.2)

Application.ScreenUpdating = True
  Application.EnableEvents = True

'Clear The Clipboard
Application.CutCopyMode = False

ThisWorkbook.Worksheets("Class Setup").Select

   WordApp.Activate


End Sub

 

[RoryA]

I can't see any unqualified objects there, but I'd suggest you try using Application.CentimetersToPoints rather than just CentimetersToPoints

 

[Nick van G]

@RoryA, thanks for the hint. The problem is indeed the unqualified method CentimetersToPoints (and similar). Using Application as a qualifier works, as long as it supports the methods (my Outlook doesn't). You can also use an Application variant (WordApp in the OP's case) or even (not tried it) leverage the With object by using .Application.CentimetersToPoints. No idea which is more efficient.