How to create two page-numbering in one document?

A

avkokin

Hello.
There is Microsoft's article "How to create two page-numbering schemes
in one document in Word 2003 and in Word 2002" on the site
http://support.microsoft.com/kb/291283/en-us. I try create my macro on
basic of it (first method with the field SEQ). But I can't overcome
numbering into header and footer. My head by this time turn. That is
the file as example (http://www.box.net/shared/repk7lsg84), and lower
my code. Please, help me and give me a tip.
Thank you very much.
My code:
Sub twinNumberingPages3()
Dim sec As Section
Dim myRange As Range
Dim myR As Range
Dim nSec As Integer
Dim nIndex As Integer
Dim i As Integer

ActiveWindow.View.ShowFieldCodes = True
nSec = ActiveDocument.Sections.Count

Selection.HomeKey unit:=wdStory

With Selection
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
preserveformatting:=False
.TypeText Text:="seq v1 \h \r "
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
preserveformatting:=False
.TypeText Text:="sectionpages"
.MoveRight unit:=wdCharacter, Count:=4
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
preserveformatting:=False
.TypeText Text:="seq v2 \h \r0"
End With
If nSec > 1 Then
For nIndex = 2 To nSec
ActiveDocument.Sections(nIndex).Range.Select
Selection.Collapse wdCollapseStart

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:="seq v1 \c", _
preserveformatting:=False '
Selection.MoveLeft unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
_
preserveformatting:=False
Selection.TypeText Text:="seq v2 \h \r"
Selection.MoveRight unit:=wdCharacter, Count:=1,
Extend:=wdExtend
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
_
preserveformatting:=False
Selection.TypeText Text:="="
Selection.MoveRight unit:=wdCharacter, Count:=5,
Extend:=wdExtend
Selection.Collapse wdCollapseEnd
'
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:="sectionpages", _
preserveformatting:=False
Selection.TypeText Text:="+"
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
Text:="seq v2 \c", _
preserveformatting:=False
Selection.MoveLeft unit:=wdCharacter, Count:=3, Extend:=wdExtend
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
_
preserveformatting:=False
Selection.TypeText Text:="="
Selection.MoveLeft unit:=wdCharacter, Count:=3, Extend:=wdExtend
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
_
preserveformatting:=False
Selection.TypeText Text:="seq v1 \h \r"
Next nIndex
End If

ActiveDocument.Range.InsertAfter vbCr
Set myR = ActiveDocument.Range
myR.Collapse direction:=wdCollapseEnd
myR.Select

With Selection
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="seq
v2 \c", preserveformatting:=False
.TypeText Text:="+"
.Fields.Add Range:=Selection.Range, Type:=wdFieldPage,
preserveformatting:=False
.MoveLeft unit:=wdCharacter, Count:=3, Extend:=wdExtend
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,
preserveformatting:=False
.TypeText Text:="="
.MoveLeft unit:=wdCharacter, Count:=3
.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
.Fields.Update
End With

Selection.Cut
ActiveDocument.Paragraphs.Last.Range.Delete
Selection.HomeKey unit:=wdStory
Set myR =
ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
myR.Collapse direction:=wdCollapseEnd
myR.Paste
Selection.HomeKey unit:=wdStory
For i = 1 To ActiveDocument.Sections.Count
Set myRange =
ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary).Range
For Each sec In ActiveDocument.Sections
With sec.Headers(wdHeaderFooterPrimary)
.Range.Fields.Add Range:=myRange, Type:=wdFieldPage,
preserveformatting:=False
.PageNumbers.RestartNumberingAtSection = True
.PageNumbers.StartingNumber = 1
End With
Next sec
Next i
ActiveWindow.View.ShowFieldCodes = False

End Sub
 
S

StevenM

To: Avkokin,

Re: http://support.microsoft.com/kb/291283/en-us

I did the "Start at 1" formatting manually.
The code contains some long lines which after coping and pasting into the
VBA editor will need straightening.

The code follows: "Method 1" in the above mentioned document.

Sub TwoPageNumbering()
Dim oRange As Range
Dim hfRange As Range
Dim nSections As Long
Dim nIndex As Long
'
' Step 1: Add two fields to the beginning of page 1
'
Set oRange = ActiveDocument.Range(0, 0)
oRange.Select
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \h \r", PreserveFormatting:=False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSectionPages,
PreserveFormatting:=False
Selection.Move wdCharacter, 1
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \h \r0", PreserveFormatting:=False
nSections = ActiveDocument.Sections.Count
'
' Step 2: Add two fields to each section after the first section
'
If nSections > 1 Then
For nIndex = 2 To nSections
Set oRange = ActiveDocument.Sections(nIndex).Range
oRange.Collapse wdCollapseStart
oRange.Select
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \h \r", PreserveFormatting:=False
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldExpression, PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \c", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \h \r", PreserveFormatting:=False
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldExpression, Text:="+", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldSectionPages, PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \c", PreserveFormatting:=False
Next nIndex
End If
'
' Step 3: Add Header and Footer
'
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
Set hfRange = oRange.Sections(1).Headers(wdHeaderFooterPrimary).Range
With hfRange
.Delete
.Text = "Page "
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
oRange.Fields.Add Range:=hfRange, Type:=wdFieldPage
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
.Text = " of "
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
oRange.Fields.Add Range:=hfRange, Type:=wdFieldSectionPages
End With
Set hfRange = oRange.Sections(1).Footers(wdHeaderFooterPrimary).Range
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
hfRange.Collapse wdCollapseStart
hfRange.Select
hfRange.Fields.Add Range:=Selection.Range, Type:=wdFieldExpression,
Text:="+", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \c", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldPage,
PreserveFormatting:=False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False

End Sub

Steven Craig Miller
 
S

StevenM

The macro should continue with:

'
' Step 4:
'
For nIndex = 1 To nSections
With ActiveDocument.Sections(nIndex).Headers(wdHeaderFooterPrimary)
.PageNumbers.NumberStyle = wdPageNumberStyleArabic
.PageNumbers.HeadingLevelForChapter = 0
.PageNumbers.IncludeChapterNumber = False
.PageNumbers.ChapterPageSeparator = wdSeparatorHyphen
.PageNumbers.RestartNumberingAtSection = True
.PageNumbers.StartingNumber = 1
End With
Next nIndex
ActiveDocument.Range(0, 0).Select
ActiveWindow.View.Type = wdPrintView
ActiveWindow.View.Zoom.PageFit = wdPageFitBestFit

I'll give the whole thing again:


Sub TwoPageNumbering()
Dim oRange As Range
Dim hfRange As Range
Dim nSections As Long
Dim nIndex As Long
'
' Step 1: Add two fields to the beginning of page 1
'
Set oRange = ActiveDocument.Range(0, 0)
oRange.Select
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \h \r", PreserveFormatting:=False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSectionPages,
PreserveFormatting:=False
Selection.Move wdCharacter, 1
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \h \r0", PreserveFormatting:=False
nSections = ActiveDocument.Sections.Count
'
' Step 2: Add two fields to each section after the first section
'
If nSections > 1 Then
For nIndex = 2 To nSections
Set oRange = ActiveDocument.Sections(nIndex).Range
oRange.Collapse wdCollapseStart
oRange.Select
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \h \r", PreserveFormatting:=False
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldExpression, PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \c", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \h \r", PreserveFormatting:=False
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldExpression, Text:="+", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldSectionPages, PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \c", PreserveFormatting:=False
Next nIndex
End If



'
' Step 3: Add Header and Footer
'
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
Set hfRange = oRange.Sections(1).Headers(wdHeaderFooterPrimary).Range
With hfRange
.Delete
.Text = "Page "
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
oRange.Fields.Add Range:=hfRange, Type:=wdFieldPage
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
.Text = " of "
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
oRange.Fields.Add Range:=hfRange, Type:=wdFieldSectionPages
End With
Set hfRange = oRange.Sections(1).Footers(wdHeaderFooterPrimary).Range
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
hfRange.Collapse wdCollapseStart
hfRange.Select
hfRange.Fields.Add Range:=Selection.Range, Type:=wdFieldExpression,
Text:="+", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \c", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldPage,
PreserveFormatting:=False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False

'
' Step 4:
'
For nIndex = 1 To nSections
With ActiveDocument.Sections(nIndex).Headers(wdHeaderFooterPrimary)
.PageNumbers.NumberStyle = wdPageNumberStyleArabic
.PageNumbers.HeadingLevelForChapter = 0
.PageNumbers.IncludeChapterNumber = False
.PageNumbers.ChapterPageSeparator = wdSeparatorHyphen
.PageNumbers.RestartNumberingAtSection = True
.PageNumbers.StartingNumber = 1
End With
Next nIndex
ActiveDocument.Range(0, 0).Select
ActiveWindow.View.Type = wdPrintView
ActiveWindow.View.Zoom.PageFit = wdPageFitBestFit
End Sub

I ran a couple tests and it seemed to work.

Steven Craig Miller
 
A

avkokin

The macro should continue with:

'
' Step 4:
'
For nIndex = 1 To nSections
With ActiveDocument.Sections(nIndex).Headers(wdHeaderFooterPrimary)
.PageNumbers.NumberStyle = wdPageNumberStyleArabic
.PageNumbers.HeadingLevelForChapter = 0
.PageNumbers.IncludeChapterNumber = False
.PageNumbers.ChapterPageSeparator = wdSeparatorHyphen
.PageNumbers.RestartNumberingAtSection = True
.PageNumbers.StartingNumber = 1
End With
Next nIndex
ActiveDocument.Range(0, 0).Select
ActiveWindow.View.Type = wdPrintView
ActiveWindow.View.Zoom.PageFit = wdPageFitBestFit

I'll give the whole thing again:

Sub TwoPageNumbering()
Dim oRange As Range
Dim hfRange As Range
Dim nSections As Long
Dim nIndex As Long
'
' Step 1: Add two fields to the beginning of page 1
'
Set oRange = ActiveDocument.Range(0, 0)
oRange.Select
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \h \r", PreserveFormatting:=False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSectionPages,
PreserveFormatting:=False
Selection.Move wdCharacter, 1
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \h \r0", PreserveFormatting:=False
nSections = ActiveDocument.Sections.Count
'
' Step 2: Add two fields to each section after the first section
'
If nSections > 1 Then
For nIndex = 2 To nSections
Set oRange = ActiveDocument.Sections(nIndex).Range
oRange.Collapse wdCollapseStart
oRange.Select
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \h \r", PreserveFormatting:=False
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldExpression, PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \c", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable1 \h \r", PreserveFormatting:=False
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldExpression, Text:="+", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range,
Type:=wdFieldSectionPages, PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \c", PreserveFormatting:=False
Next nIndex
End If

'
' Step 3: Add Header and Footer
'
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
Set hfRange = oRange.Sections(1).Headers(wdHeaderFooterPrimary).Range
With hfRange
.Delete
.Text = "Page "
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
oRange.Fields.Add Range:=hfRange, Type:=wdFieldPage
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
.Text = " of "
.MoveEnd unit:=wdCharacter, Count:=1
.Collapse wdCollapseEnd
oRange.Fields.Add Range:=hfRange, Type:=wdFieldSectionPages
End With
Set hfRange = oRange.Sections(1).Footers(wdHeaderFooterPrimary).Range
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
hfRange.Collapse wdCollapseStart
hfRange.Select
hfRange.Fields.Add Range:=Selection.Range, Type:=wdFieldExpression,
Text:="+", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence,
Text:="variable2 \c", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldPage,
PreserveFormatting:=False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False

'
' Step 4:
'
For nIndex = 1 To nSections
With ActiveDocument.Sections(nIndex).Headers(wdHeaderFooterPrimary)
.PageNumbers.NumberStyle = wdPageNumberStyleArabic
.PageNumbers.HeadingLevelForChapter = 0
.PageNumbers.IncludeChapterNumber = False
.PageNumbers.ChapterPageSeparator = wdSeparatorHyphen
.PageNumbers.RestartNumberingAtSection = True
.PageNumbers.StartingNumber = 1
End With
Next nIndex
ActiveDocument.Range(0, 0).Select
ActiveWindow.View.Type = wdPrintView
ActiveWindow.View.Zoom.PageFit = wdPageFitBestFit
End Sub

I ran a couple tests and it seemed to work.

Steven Craig Miller
Click to expand...

Thank you very much, Steven!
 
A

avkokin

Thank you very much, Steven!
Click to expand...

Dear Steven!
This code is excellent. But it incorrect working in Word 2007. The
Footer start number is 1 on all sections. How can it repairing?
Thank's.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro programming 1
Macro to Select text from a point given to a specific word 2
Select Text to End of Footnote 9
Worked in 2003, not in 2007 6
Wherein my mistake? 1
Looping 2
How to correct a mistake into macro? 2
VBA Word Footers.... 4

Top