Sub newSplitFile()
On Error Resume Next
Application.ScreenUpdating = False
Selection.EndKey Unit:=wdStory
Selection.InsertBreak Type:=wdPageBreak
Pages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
ChangeFileOpenDirectory ActiveDocument.Path
j = 0
For i = 0 To Pages – 1
[COLOR=#ff0000]‘ Pages là tổng số trang, vậy bạn đổi (pages -1) cho phù hợp[/COLOR]
Selection.HomeKey Unit:=wdStory
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
[COLOR=#ff0000]'câu này chọn đến trang bạn muốn ngắt, => đổi Count cho phù hợp[/COLOR]
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
Selection.Cut
Selection.TypeBackspace
Selection.HomeKey Unit:=wdStory
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Stt = Mid(Selection.Text, InStr(1, Selection.Text, ": ") + 1, Len(Selection.Text))
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, Name:=""
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
tennv = Mid(Selection.Text, InStr(1, Selection.Text, ": ") + 1, Len(Selection.Text))
Fname = "File_" & Stt & "_" & tennv & ".docx"
If Fname <> "File__.docx" Then j = j + 1
ActiveDocument.SaveAs2 FileName:=Fname, FileFormat:=wdFormatXMLDocument, LockComments:=False, _
Password:="", AddToRecentFiles:=True, WritePassword:="", _
ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False, CompatibilityMode:=14
Selection.WholeStory
Selection.Paste
Next i
Application.ScreenUpdating = True
MsgBox "Done!" & Chr(13) & "There's " & j & " page(s) were saved !"
End Sub
