我有一个大字doc(100页),我试图将文档拆分成几个较小的文档,然后将每个文档作为.pdf保存到用户定义的位置。到目前为止,我已经将它划分为分隔符并且保存为.pdf完全没问题。
另一方面,拆分功能似乎是从页面中删除所有格式,只是输出为纯文本。有什么方法可以解决这个问题吗?巧合的是,分裂意味着每3页......有没有办法将范围设置为3页的块?
Sub SplitNotes(delim As String, strFileName As String)
Dim fDialog As FileDialog
Dim X
Dim Doc As Document
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder to save split files"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User"
Exit Sub
End If
DocDir = fDialog.SelectedItems.Item(1)
arrNotes = Split(ActiveDocument.Range, delim)
Response = MsgBox("This will split the document into " & UBound(arrNotes) + 1 & " sections. Do you wish to preceed?", 4)
If Response = 7 Then Exit Sub
For I = LBound(arrNotes) To UBound(arrNotes)
If Trim(arrNotes(I)) <> "" Then
X = X + 1
ActiveDocument.Range = arrNotes(I)
ActiveDocument.Range.Copy
Set Doc = Documents.Add
ActiveDocument.Range.Paste
ActiveDocument.SaveAs FileName:=DocDir & "\" & X & ".PDF", FileFormat:=wdFormatPDF
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
Next
End With
End Sub
Sub test()
'delimiter & filename
SplitNotes "MyText", "Notes "
End Sub
答案 0 :(得分:0)
以下代码将选择三个页面并将其复制到一个新页面,该页面将保存为PDF,然后将选择并复制接下来的三个页面,等等。
空白的附加页面仍然存在一些问题,我现在无法解决。
Sub SplitDocument()
Dim rgePages As Range
iCurrentPage = 1
Set docMultiple = ActiveDocument
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)
counter = 0
Do Until (counter * 3) + 1 > iPageCount
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=(counter * 3) + 1
Set rgePages = Selection.Range
counter = counter + 1
If counter * 3 > iPageCount Then
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=iPageCount
Else
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=(counter * 3)
End If
rgePages.End = Selection.Bookmarks("\Page").Range.End
rgePages.Select
rgePages.Copy
Set docSingle = Documents.Add
docSingle.Range.Paste
strNewFileName = "C:\Temp\DocumentPart" & "_" & counter & ".PDF"
docSingle.SaveAs strNewFileName, FileFormat:=wdFormatPDF
docSingle.Close SaveChanges:=False
rgePages.Collapse wdCollapseEnd
Loop
End Sub