Reviewing Balloons being 'on' cause error in macro

[Cissy]

Hi,

Very strange, but I get a "VALUE OUT OF RANGE" error when I run the
following macro, only when I have my Balloons on (Reviewing toolbar, Show,
Options, Balloons). I've tried everything I know, any ideas would be
appreciated. Happy Holidays!

Sub StampinFooter()

If Documents.Count = 0 Then Exit Sub

MACRO STOPS AND GIVES ERROR FOR THE FOLLOWING LINE:
If Selection.PageSetup.DifferentFirstPageHeaderFooter = True Then

Selection.EndKey unit:=wdStory
Selection.InsertBreak Type:=wdPageBreak

Call DeleteFooters 'scrubs footers in all sections

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"FILENAME \* Lower ", PreserveFormatting:=True

Selection.HomeKey unit:=wdLine, Extend:=wdExtend
With Selection.Font
.Name = "Times New Roman"
.Size = 8
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With

Selection.Fields.Locked = True


Selection.WholeStory
Selection.Copy
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Selection.EndKey unit:=wdStory
Selection.TypeBackspace


Selection.HomeKey unit:=wdStory

'ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
ActiveWindow.ActivePane.View.SeekView = wdSeekFirstPageFooter

Selection.PasteAndFormat (wdPasteDefault)
Selection.TypeBackspace
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument


Else

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter

Call DeleteFooters

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:= _
"FILENAME \* Lower ", PreserveFormatting:=True

Selection.HomeKey unit:=wdLine, Extend:=wdExtend
With Selection.Font
.Name = "Times New Roman"
.Size = 8
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = wdColorAutomatic
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = 0
.Scaling = 100
.Position = 0
.Kerning = 0
.Animation = wdAnimationNone
End With

Selection.Fields.Locked = True

' Selection.HeaderFooter.PageNumbers.Add PageNumberAlignment:= _
' wdAlignPageNumberCenter, FirstPage:=False
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument


Application.Browser.Target = wdBrowsePage
Application.Browser.Next

Selection.HomeKey unit:=wdStory

Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Forward = True
End With
Selection.Find.Execute

Selection.HomeKey unit:=wdStory

End If

End Sub

 

[Jean-Guy Marcil]

Cissy was telling us:
Cissy nous racontait que :

Hi,

Very strange, but I get a "VALUE OUT OF RANGE" error when I run the
following macro, only when I have my Balloons on (Reviewing toolbar,
Show, Options, Balloons). I've tried everything I know, any ideas
would be appreciated. Happy Holidays!

I tried your code as is in a document that had track changes on and that had
some balloons in the margins. No problems, no error messages.
I am usingWord 2003 with the latest patches.

By the way, try removing the Selection object like this:

'_______________________________________
Dim footerRange As Range
If Documents.Count = 0 Then Exit Sub

If Selection.PageSetup.DifferentFirstPageHeaderFooter = True Then
'Why check the current section, but than go to the end of the document?
'It might be different there, no?

With ActiveDocument.Range
'Why add a page break?
.Collapse wdCollapseEnd
.InsertBreak wdPageBreak

Set footerRange = .Sections(.Sections.Count) _
.Footers(wdHeaderFooterFirstPage).Range
With footerRange
.Fields.Add Range:=footerRange, Type:=wdFieldEmpty, Text:= _
"FILENAME \* Lower ", PreserveFormatting:=True
With .Font
.Name = "Times New Roman"
.Size = 8
End With
.Fields.Locked = True
End With
'Why copy the last section footer to the first section?
'What if all sections are set to "Same as Previous"
'Than all you need is add the text to the first footer
With ActiveDocument.Sections
If .Count > 1 Then
.Item(1).Footers(wdHeaderFooterFirstPage) _
.Range.FormattedText = footerRange
End If
End With
End With

Else

'etc.

End If
'_______________________________________

The Selection object leads to complicated code to maintain and can be
difficult to handle, especially when you start opening/closing header/footer
panes...

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org