Question

我创建了一个宏，它根据用户输入将Word文档拆分为较小的文档，然后将它们输出为具有唯一名称的.pdf。每个单独的文档虽然在背面输出一个额外的空白页面，但原始文档中没有任何空白页面。在保存到.pdf之前，有没有办法阻止这种情况发生/删除后页？我已经尝试通过分节符删除最后一页，但这也没有用。

Sub SplitToPDF()

Dim docMultiple As Document
Dim docSingle As Document
Dim rngPage As Range
Dim iCurrentPage As Integer
Dim iPageCount As Integer
Dim strNewFileName As String
Dim fDialog As FileDialog
Dim x As Integer
Dim Response As VbMsgBoxResult
Dim userInput As Integer
Dim fso
Dim currentDate As String
Dim customerName As String
Dim currentMonth As String
Dim currentYear As Integer

Response = MsgBox("Insturctions for use:" & vbNewLine & "Please ensure the first blank page has been deleted." & vbNewLine & "Please ensure you have saved (and re-named) this document to the fund operation name." & vbNewLine & vbNewLine & "This will also overwrite any other split you have done in the same folder. Continue?", vbExclamation + vbYesNo, "Warning!")
If Response = vbNo Then Exit Sub

inputData = InputBox("Please enter the length of each letter below.", "Notice length:")
If inputData = "" Then Exit Sub

'   1 Create dialog for saving and get directory details
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", vbInformation
        Exit Sub
    End If
    DocDir = fDialog.SelectedItems.Item(1)
End With

Application.ScreenUpdating = False

Set docMultiple = ActiveDocument
Set rngPage = docMultiple.Range
iCurrentPage = 1
iPageCount = docMultiple.BuiltInDocumentProperties(wdPropertyPages)

'   2 Loop through each page set and copy/paste data
Do Until iCurrentPage > iPageCount
    If iCurrentPage = iPageCount Then
        rngPage.End = ActiveDocument.Range.End
    Else
        Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + inputData
        rngPage.End = Selection.Start
    End If

    rngPage.Copy
    Set docSingle = Documents.Add
    docSingle.Range.Paste

    For i = 0 To docSingle.Sections.Count
    Next

    Set delSec = docSingle.Sections(i)
    delSec.Range.Delete

'   3 Variable for document name
    Application.Selection.Find.Execute "customer: "
    Application.Selection.Expand wdLine
    customerName = Replace(Application.Selection.Text, "customer: ", "")
    x = Len(customerName) - 1
    customerName = Left(customerName, x)

    Set fso = CreateObject("Scripting.FileSystemObject")

    currentDate = Replace(Date, "/", "-")
    currentMonth = Format(currentDate, "MMM")
    currentYear = Format(currentDate, "YY")
    currentDate = currentMonth & "_" & currentYear

    strNewFileName = fso.GetBaseName(docMultiple) & "_" & currentDate & "_" & customerName & ".pdf"
    docSingle.SaveAs FileName:=DocDir & "\" & strNewFileName, FileFormat:=wdFormatPDF

    iCurrentPage = iCurrentPage + inputData

    docSingle.Close SaveChanges:=wdDoNotSaveChanges
    rngPage.Collapse wdCollapseEnd
Loop

Application.ScreenUpdating = True

MsgBox "Complete", vbInformation

Set docMultiple = Nothing
Set docSingle = Nothing
Set rngPage = Nothing

End Sub

Answer 1

在第2步（循环浏览页面集）中，在完成粘贴（第57行）之后添加以下内容：

    ' There is now an empty page at the end of the document.
    ' This is caused by a section break. Get rid of it.
    Selection.MoveLeft
    Selection.Delete

删除循环部分的额外代码。

分割文档的Word宏正在创建一个额外的页面

1 个答案: