PDA

View Full Version : Run Time Error 4605 when adding Headers and Footers using a macro



ResourceGrou
06-20-2013, 07:59 AM
I am, at the request of a user, attempting to modify a macro which creates headers and footers to allow different footers on the second page onwards, as well as no header, but I cannot get this to successfully run. I receive a
"Run Time Error 4605: This method or property is not available because the object refers to a drawing object" when i reach a certain point in the macro. Any assistance as to why this macro crashes would be appreciated


Sub RTC_HeaderFooter()

' Get UK or International
Do
blnOk = False
Load RTC_Company
RTC_Company.OptionButton1.Value = True
RTC_Company.OptionButton2.Value = False
RTC_Company.Show
If Not blnOk Then
MsgBox "Cancelled", vbCritical
Exit Sub
End If
Loop Until True ' no loop needed really. Leave in case more questions to be asked
Application.Visible = False
Add_HeaderFooter
Application.Visible = True
End Sub
Private Sub Add_HeaderFooter()
Dim Logos(6) As String
Dim LogoOffset As Integer

Logos(1) = "RTC Plc Header.jpg"
Logos(2) = "RTC Intl Header.jpg"
Logos(3) = "RTC Plc Footer.jpg"
Logos(4) = "RTC Intl Footer.jpg"
Logos(5) = "RTC_AddressBox.JPG"
Logos(6) = "RTC_AddressBoxTest.jpg"
LogoOffset = IIf(blnUK, 0, 1)
' Make sure in print view so headers/footers can be added
Selection.HomeKey Unit:=wdStory
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = CentimetersToPoints(4.5)
.BottomMargin = CentimetersToPoints(3)
.LeftMargin = CentimetersToPoints(2.5)
.RightMargin = CentimetersToPoints(2.5)
.Gutter = CentimetersToPoints(0)
.HeaderDistance = CentimetersToPoints(1.25)
.FooterDistance = CentimetersToPoints(1)
.DifferentFirstPageHeaderFooter = True
End With
' Now set Page 1 header
With ActiveDocument.ActiveWindow.View
.Type = wdPrintView
.SeekView = wdSeekCurrentPageHeader
End With
ActiveDocument.Shapes.AddPicture Anchor:=Selection.Range, _
FileName:=AddonLocation & Logos(1 + LogoOffset), _
LinkToFile:=False, SaveWithDocument:=True
Selection.HeaderFooter.Shapes(Selection.HeaderFooter.Shapes.Count).Select
With Selection.ShapeRange
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Width = CentimetersToPoints(HeaderWidth)
.Height = CentimetersToPoints(IIf(blnUK, HeaderHeightUK, HeaderHeightInter))
.Left = CentimetersToPoints(HeaderLeft)
.Top = CentimetersToPoints(HeaderTop)
End With
' Now set Page 1 footer
With ActiveDocument.ActiveWindow.View
.Type = wdPrintView
.SeekView = wdSeekCurrentPageFooter
End With
ActiveDocument.Shapes.AddPicture Anchor:=Selection.Range, _
FileName:=AddonLocation & Logos(6), _
LinkToFile:=False, SaveWithDocument:=True
Selection.HeaderFooter.Shapes(Selection.HeaderFooter.Shapes.Count).Select
With Selection.ShapeRange
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Width = CentimetersToPoints(ISOLogoFooterWidth)
.Height = CentimetersToPoints(ISOLogoFooterHeight)
.Left = CentimetersToPoints(ISOLogoFooterLeft)
.Top = CentimetersToPoints(ISOLogoFooterTop)
.WrapFormat.AllowOverlap = True
.WrapFormat.Side = wdWrapBoth
.WrapFormat.DistanceTop = CentimetersToPoints(0)
.WrapFormat.DistanceBottom = CentimetersToPoints(0)
.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
.WrapFormat.Type = 3
.ZOrder 5
End With
' Now set other pages footer
If ActiveDocument.ActiveWindow.Panes(1).Pages.Count > 1 Then
ActiveWindow.ActivePane.View.NextHeaderFooter
ActiveDocument.Shapes.AddPicture Anchor:=Selection.Range, _
FileName:=AddonLocation & Logos(3 + LogoOffset), _
LinkToFile:=False, SaveWithDocument:=True
Selection.HeaderFooter.Shapes(Selection.HeaderFooter.Shapes.Count).Select
With Selection.ShapeRange
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Width = CentimetersToPoints(FooterWidth)
.Height = CentimetersToPoints(FooterHeight)
.Left = CentimetersToPoints(FooterLeft)
.Top = CentimetersToPoints(FooterTop)
End With
End If
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Application.Visible = True
End Sub

It crashes at


' Now set other pages footer
If ActiveDocument.ActiveWindow.Panes(1).Pages.Count > 1 Then
ActiveWindow.ActivePane.View.NextHeaderFooter

SamT
06-24-2013, 05:57 PM
Private Sub Add_HeaderFooter()
Dim Logos(6) As String
Dim LogoOffset As Integer
Logos(1) = "RTC Plc Header.jpg"
'
'
'
LogoOffset = IIf(blnUK, 0, 1)

Application.ScreenUpdating = False

'Avoid use of "Selection"
With ActiveDocument.Sections(1)
With .Headers(wdHeaderFooterFirstPage)
.Range ("Add Text etc")
.Shapes.AddPicture (Logos(N))
'Format header, text, picture
End With

With .Footers(wdHeaderFooterFirstPage)
'Repeat as above
.Shapes.AddPicture (Logos(N))
End With

'With other HeadersFooters
'Repeat as above
End With

Application.ScreenUpdating = True
End Sub


Edit: BTW, Panes don't have Pages, that's why your code errored out there.

ResourceGrou
06-26-2013, 08:00 AM
When I insert this macro with what I think is configured, I get "invalid use of Property" highlighting the Private Sub

Sorry for this, I know very little about VB in general, and have actually just inherited this from another user by default