下面是按页拆分word文档的程序,请参考:
Option Explicit
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oNewDoc As Word.Document
Dim oRange As Word.Range
Dim iPageNumber As Integer
Dim iCount As Integer
Dim strTestDir As String
Dim strTestFile As String
Private Sub Command1_Click()
Command1.Visible = False
Dim lCurrentStart As Long
Dim lCurrentEnd As Long
Dim lDocumentEnd As Long
Dim lOutputCount As Long
lOutputCount = 0
'Launch Word and make it visible
Set oWord = CreateObject("Word.Application")
oWord.Visible = True
'Open the test document
Set oDoc = oWord.Documents.Open(FileName:="C:\ThreePageDocument.doc")
'Find the beginning end of the document
oDoc.Select
lCurrentStart = oWord.Selection.Start
lCurrentEnd = lCurrentStart
lDocumentEnd = oWord.Selection.End
'Move the insertion point to the beginning of the document
oWord.Selection.Collapse wdCollapseStart
Do While (lCurrentEnd < lDocumentEnd)
'Move the insertion pointer to the bottom of this page
oWord.Browser.Target = wdBrowsePage
oWord.Browser.Next
lCurrentEnd = oWord.Selection.End
'On the last page, the start and end will be the same
If (lCurrentStart = lCurrentEnd) Then
lCurrentEnd = lDocumentEnd
End If
'Capture the Range of the current page
Set oRange = oDoc.Range(lCurrentStart, lCurrentEnd)
'Create a new document and copy the range to it
Set oNewDoc = oWord.Documents.Add
oRange.Copy
oNewDoc.Range(0, 0).Paste
'Release the Range so we don't leak references
Set oRange = Nothing
'Save the new document and close it
oNewDoc.SaveAs FileName:="C:\Result" & lOutputCount & ".doc"
' You can save as another FileFormat. If so, change the
' file extension accordingly.
oNewDoc.Close
Set oNewDoc = Nothing
'Increment the output counter so we don't overwrite this file later
lOutputCount = lOutputCount + 1
'Reset the current start position
lCurrentStart = oWord.Selection.End
Loop
End Sub
代码如下。VB的。不需要什么控件,直接复制代码运行即可。我默认文件d:\a.doc,保存在d:\1.doc,d:\2.doc(有几页就有几个文件)....中。
==========
Private Sub Form_Load()
Dim w As Object, d As Object, s As Object, page As Object, i As Integer
Set w = CreateObject("WORD.application")
w.Visible = True
Set d = w.Documents.Open("d:\a.doc")
For Each page In d.ActiveWindow.ActivePane.Pages
i = i + 1
Set s = w.Documents.Add
s.Content = page.Rectangles.Item(1).Range
s.SaveAs "d:\" & i & ".doc"
Next
Set w = Nothing
Set d = Nothing
Set s = Nothing
MsgBox "完毕"
End
End Sub
VB或VBA是什么呀?