2014-03-28 58 views
1

我已經創建了一個宏,根據用戶輸入,將Word文檔拆分爲較小的文檔,然後將它們輸出爲具有唯一名稱的.pdf。雖然每個單獨的文檔都在後面輸出一個額外的空白頁面,而這些空白頁面並不在原始文檔中。有沒有辦法阻止這種情況發生/刪除後頁面保存到.pdf之前?我試圖刪除最後一頁的分節,但也沒有奏效。Word宏分割文檔正在創建一個額外的頁面

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 

末次

+0

你能展示你的整個代碼嗎? –

+0

我已經更新了現在的問題。謝謝。 – steve

+0

這是無效的代碼,有一些明顯的錯誤,你應該先改進。您還應該解釋實際上「用戶輸入」以及它如何引用「拆分」過程。 –

回答

0

在步驟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 

刪除多餘的代碼循環通過部分。