Microsoft Office Tutorials and References
In Depth Information
Transferring a Selection to a New Document
ElseIf .Count > 1 And Not .EvenlySpaced Then¶
For i = 1 To .Count¶
.Width = origSetup.TextColumns(i).Width¶
Next¶
End If¶
End With¶
End With¶
'Define headers, footers and page numbers¶
Dim pgNr As Long¶
'Get the starting page number¶
rngSel.Collapse wdCollapseStart¶
pgNr = rngSel.Information(wdActiveEndAdjustedPageNumber)¶
'Disables different first page if selection is not on a first page¶
'Comment out the following first, and fourth through seventh¶
' lines to see first page headers/footers¶
' in result document if present in original even if¶
' selection is not originally on a first page¶
If pgNr = 1 Then¶
ProcessHeadersFooters wdHeaderFooterFirstPage, _¶
rngSel.Sections(1), docNew.Sections(1)¶
Else¶
docNew.Sections(1).PageSetup. _¶
DifferentFirstPageHeaderFooter = False¶
End If¶
'To NOT retain the original page number,¶
'comment out the next four lines¶
With docNew.Sections(1).Headers(wdHeaderFooterPrimary)¶
.PageNumbers.RestartNumberingAtSection = True¶
.PageNumbers.StartingNumber = pgNr¶
End With¶
ProcessHeadersFooters wdHeaderFooterPrimary, _¶
rngSel.Sections(1), docNew.Sections(1)¶
ProcessHeadersFooters wdHeaderFooterEvenPages, _¶
rngSel.Sections(1), docNew.Sections(1)¶
'Display the FileSaveAs dialog box¶
Dialogs(wdDialogFileSaveAs).Show¶
End Sub¶
' * * * * *¶
'Carry over formatted text for the selected section¶
'from original document and update the fields¶
Sub ProcessHeadersFooters(typ As Long, _¶
sec1 As Word.Section, sec2 As Word.Section)¶
sec2.Headers(typ).Range.FormattedText = _¶
sec1.Headers(typ).Range.FormattedText¶
sec2.Headers(typ).Range.Fields.Update¶
sec2.Footers(typ).Range.FormattedText = _¶
sec1.Footers(typ).Range.FormattedText¶
sec2.Footers(typ).Range.Fields.Update¶
End Sub¶
Wrd
Search JabSto ::




Custom Search