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
"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