按字符串拆分文档并输出为.pdf - 拆分功能不起作用

时间:2014-01-03 14:35:39

标签: vba ms-word

我有一个大字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

1 个答案:

答案 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