bobjohnson
12-10-2008, 01:36 PM
Hi, im trying to create a VBA macro for word 2003 that will delete all of the header and footer information throughout a document.
This is what ive come up with so far:
Sub PullHeadFoot()
ActiveWindow.View.Type = wdPrintView
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
Selection.HomeKey Unit:=wdStory
cursec = 1
curpg = 1
Do
ActiveDocument.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
Selection.WholeStory
Selection.Delete
ActiveDocument.ActiveWindow.View.SeekView = wdSeekCurrentPageFooter
Selection.WholeStory
Selection.Delete
Selection.MoveDown Unit:=wdScreen, Count:=1
Selection.MoveDown Unit:=wdWindow, Count:=-1
curpg = curpg + 1
Loop Until curpg = ActiveDocument.ActiveWindow.Panes(1).Pages.Count + 1
Do
ActiveDocument.Sections(cursec).headers(wdHeaderFooterPrimary).Range.Delete
ActiveDocument.Sections(cursec).Footers(wdHeaderFooterPrimary).Range.Delete
ActiveDocument.Sections(cursec).headers(wdHeaderFooterEvenPages).Range.Dele te
ActiveDocument.Sections(cursec).Footers(wdHeaderFooterEvenPages).Range.Dele te
ActiveDocument.Sections(cursec).headers(wdHeaderFooterFirstPage).Range.Dele te
ActiveDocument.Sections(cursec).Footers(wdHeaderFooterFirstPage).Range.Dele te
cursec = cursec + 1
Loop Until cursec = ActiveDocument.Sections.Last.Index + 1
End Sub
However, this macro sometimes deletes all of the headers and footers, but also sometimes leaves the headers and footers existing in the document but with 1 blank line. Ive also seen it miss a header/footer, but that was a one-off occassion.
Can anyone help me? Im sure theres got to be a simpler and more consistent way but i have no idea how to do it.
This is what ive come up with so far:
Sub PullHeadFoot()
ActiveWindow.View.Type = wdPrintView
ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitFullPage
Selection.HomeKey Unit:=wdStory
cursec = 1
curpg = 1
Do
ActiveDocument.ActiveWindow.View.SeekView = wdSeekCurrentPageHeader
Selection.WholeStory
Selection.Delete
ActiveDocument.ActiveWindow.View.SeekView = wdSeekCurrentPageFooter
Selection.WholeStory
Selection.Delete
Selection.MoveDown Unit:=wdScreen, Count:=1
Selection.MoveDown Unit:=wdWindow, Count:=-1
curpg = curpg + 1
Loop Until curpg = ActiveDocument.ActiveWindow.Panes(1).Pages.Count + 1
Do
ActiveDocument.Sections(cursec).headers(wdHeaderFooterPrimary).Range.Delete
ActiveDocument.Sections(cursec).Footers(wdHeaderFooterPrimary).Range.Delete
ActiveDocument.Sections(cursec).headers(wdHeaderFooterEvenPages).Range.Dele te
ActiveDocument.Sections(cursec).Footers(wdHeaderFooterEvenPages).Range.Dele te
ActiveDocument.Sections(cursec).headers(wdHeaderFooterFirstPage).Range.Dele te
ActiveDocument.Sections(cursec).Footers(wdHeaderFooterFirstPage).Range.Dele te
cursec = cursec + 1
Loop Until cursec = ActiveDocument.Sections.Last.Index + 1
End Sub
However, this macro sometimes deletes all of the headers and footers, but also sometimes leaves the headers and footers existing in the document but with 1 blank line. Ive also seen it miss a header/footer, but that was a one-off occassion.
Can anyone help me? Im sure theres got to be a simpler and more consistent way but i have no idea how to do it.