VB 怎么按页拆分word文档?

我的word中有好多页,我想用VB或VBA拆分成一页一个单独的word文档请大家帮忙,谢谢怎么没人理睬呢?在线等!谢谢ARTERIOSCLEROS的回答,但是我运行程序时,提示下面的代码有问题:“对象不支持该属性或方法”For Each page In d.ActiveWindow.ActivePane.Pages请问怎么回事?
2026年09月28日 13:02
有3个网友回答
网友(1):

下面是按页拆分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

网友(2):

代码如下。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

网友(3):

VB或VBA是什么呀?