word分割的宏

Option Explicit

Sub SplitPagesAsDocuments()

Dim oSrcDoc As Document, oNewDoc As Document

Dim strSrcName As String, strNewName As String

Dim oRange As Range

Dim nIndex As Integer

Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")

Set oSrcDoc = ActiveDocument

Set oRange = oSrcDoc.Content

oRange.Collapse wdCollapseStart

oRange.Select

For nIndex = 1 To ActiveDocument.Content.Information(wdNumberOfPagesInDocument)

oSrcDoc.Bookmarks("\page").Range.Copy

oSrcDoc.Windows(1).Activate

Application.Browser.Target = wdBrowsePage

Application.Browser.Next

strSrcName = oSrcDoc.FullName

strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _

fso.GetBaseName(strSrcName) & "_" & nIndex & "." & fso.GetExtensionName(strSrcName))

Set oNewDoc = Documents.Add

Selection.Paste

Selection.MoveDown Unit:=wdLine, Count:=58

With Selection.PageSetup

.LineNumbering.Active = False

.Orientation = wdOrientPortrait

.TopMargin = CentimetersToPoints(1.27)

.BottomMargin = CentimetersToPoints(1.27)

.LeftMargin = CentimetersToPoints(1.27)

.RightMargin = CentimetersToPoints(1.27)

.Gutter = CentimetersToPoints(0)

.HeaderDistance = CentimetersToPoints(1.5)

.FooterDistance = CentimetersToPoints(1.75)

.PageWidth = CentimetersToPoints(21)

.PageHeight = CentimetersToPoints(29.7)

.FirstPageTray = wdPrinterDefaultBin

.OtherPagesTray = wdPrinterDefaultBin

.SectionStart = wdSectionNewPage

.OddAndEvenPagesHeaderFooter = False

.DifferentFirstPageHeaderFooter = False

.VerticalAlignment = wdAlignVerticalTop

.SuppressEndnotes = False

.MirrorMargins = False

.TwoPagesOnOne = False

.BookFoldPrinting = False

.BookFoldRevPrinting = False

.BookFoldPrintingSheets = 1

.GutterPos = wdGutterPosLeft

.CharsLine = 39

.LinesPage = 44

.LayoutMode = wdLayoutModeLineGrid

End With

WordBasic.PageSetupPaper Tab:=1, PaperSize:=0, TopMargin:="1.27", _

BottomMargin:="1.27", LeftMargin:="1.27", RightMargin:="1.27", Gutter:= _

"0", PageWidth:="29.7", PageHeight:="30", Orientation:=0, FirstPage:=0, _

OtherPages:=0, VertAlign:=0, ApplyPropsTo:=0, FacingPages:=0, _

HeaderDistance:="1.5", FooterDistance:="1.75", SectionStart:=2, _

OddAndEvenPages:=0, DifferentFirstPage:=0, Endnotes:=0, LineNum:=0, _

CountBy:=0, TwoOnOne:=0, GutterPosition:=0, LayoutMode:=2, DocFontName:= _

"", FirstPageOnLeft:=0, SectionType:=1, FolioPrint:=0, ReverseFolio:=0, _

FolioPages:=1

With Selection.ParagraphFormat

.LeftIndent = CentimetersToPoints(0)

.RightIndent = CentimetersToPoints(0)

.SpaceBefore = 0

.SpaceBeforeAuto = False

.SpaceAfter = 0

.SpaceAfterAuto = False

.LineSpacingRule = wdLineSpaceExactly

.LineSpacing = 1

.Alignment = wdAlignParagraphJustify

.WidowControl = False

.KeepWithNext = False

.KeepTogether = False

.PageBreakBefore = False

.NoLineNumber = False

.Hyphenation = True

.FirstLineIndent = CentimetersToPoints(0)

.OutlineLevel = wdOutlineLevelBodyText

.CharacterUnitLeftIndent = 0

.CharacterUnitRightIndent = 0

.CharacterUnitFirstLineIndent = 0

.LineUnitBefore = 0

.LineUnitAfter = 0

.MirrorIndents = False

.TextboxTightWrap = wdTightNone

.AutoAdjustRightIndent = True

.DisableLineHeightGrid = False

.FarEastLineBreakControl = True

.WordWrap = True

.HangingPunctuation = True

.HalfWidthPunctuationOnTopOfLine = False

.AddSpaceBetweenFarEastAndAlpha = True

.AddSpaceBetweenFarEastAndDigit = True

.BaseLineAlignment = wdBaselineAlignAuto

End With

Selection.MoveUp Unit:=wdLine, Count:=1

Selection.Delete Unit:=wdCharacter, Count:=1

oNewDoc.SaveAs strNewName

oNewDoc.Close False

Next

Set oNewDoc = Nothing

Set oRange = Nothing

Set oSrcDoc = Nothing

Set fso = Nothing

MsgBox "结束！"

End Sub