VB 怎么按页拆分word文档?

我的word中有好多页,我想用VB或VBA拆分成一页一个单独的word文档
请大家帮忙,谢谢
怎么没人理睬呢?
在线等!

谢谢ARTERIOSCLEROS的回答,但是我运行程序时,提示下面的代码有问题:“对象不支持该属性或方法”
For Each page In d.ActiveWindow.ActivePane.Pages

请问怎么回事?

下面是按页拆分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
温馨提示:答案为网友推荐,仅供参考
第1个回答  2008-10-19
代码如下。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
第2个回答  2008-10-18
VB或VBA是什么呀?
相似回答