Last active
November 25, 2022 21:36
-
-
Save lukluca/47525b1d0b9c36e3b071f2ae357b4152 to your computer and use it in GitHub Desktop.
Visual Basic function to save data as separated pdfs in multiple pages
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sub SaveAsSeparatePDFs() | |
'Updated by LukLuca 9-11-2020 | |
Dim xPathStr As Variant | |
Dim xDictoryStr As String | |
Dim xFileDlg As FileDialog | |
Dim xStartPage, xEndPage, xPages As Long | |
Dim xStartPageStr, xEndPageStr, xPagesStr As String | |
Dim xScaledEndPage As Long | |
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker) | |
If xFileDlg.Show <> -1 Then | |
MsgBox "Please chose a valid directory", vbInformation, "Kutools for Word" | |
Exit Sub | |
End If | |
xPathStr = xFileDlg.SelectedItems(1) | |
xStartPageStr = InputBox("Begin saving PDFs starting with page __? " & vbNewLine & "(ex: 1)", "Kutools for Word") | |
xEndPageStr = InputBox("Save PDFs until page __?" & vbNewLine & "(ex: 7)", "Kutools for Word") | |
xPagesStr = InputBox("Number of pages inside a file __?" & vbNewLine & "(ex: 15)", "Kutools for Word") | |
If Not (IsNumeric(xStartPageStr) And IsNumeric(xEndPageStr) And IsNumeric(xPagesStr)) Then | |
MsgBox "The entered start page, end page and number of pages should be in number format", vbInformation, "Kutools for Word" | |
Exit Sub | |
End If | |
xStartPage = CInt(xStartPageStr) | |
xEndPage = CInt(xEndPageStr) | |
xPages = CInt(xPagesStr) | |
If xStartPage > xEndPage Then | |
MsgBox "The start page number can't be larger than end page", vbInformation, "Kutools for Word" | |
Exit Sub | |
End If | |
If xPages = 0 Then | |
MsgBox "The number of pages must be greater than 0", vbInformation, "Kutools for Word" | |
Exit Sub | |
End If | |
If xEndPage > ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) Then | |
xEndPage = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages) | |
End If | |
xScaledEndPage = xEndPage - xStartPage | |
Dim I As Long | |
If xScaledEndPage < xPages Then | |
ActiveDocument.ExportAsFixedFormat xPathStr & "\Page_" & I & ".pdf", _ | |
wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportFromTo, xStartPage, xEndPage, wdExportDocumentWithMarkup, _ | |
False, False, wdExportCreateHeadingBookmarks, True, False, False | |
End If | |
Dim J As Long | |
Dim T As Long | |
If xScaledEndPage >= xPages Then | |
Dim resultValue As Integer | |
Dim modResult As Integer | |
resultValue = xScaledEndPage \ xPages | |
modResult = xScaledEndPage Mod xPages | |
If modResult = 0 Then | |
J = xStartPage | |
T = xStartPage + xPages | |
resultValue = resultValue - 1 | |
For I = 0 To resultValue | |
ActiveDocument.ExportAsFixedFormat xPathStr & "\Page_" & I & ".pdf", _ | |
wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportFromTo, J, T, wdExportDocumentWithMarkup, _ | |
False, False, wdExportCreateHeadingBookmarks, True, False, False | |
J = T | |
T = T + xPages | |
Next | |
End If | |
If modResult > 0 Then | |
J = xStartPage | |
T = xStartPage + xPages | |
resultValue = resultValue - 1 | |
For I = 0 To resultValue | |
ActiveDocument.ExportAsFixedFormat xPathStr & "\Page_" & I & ".pdf", _ | |
wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportFromTo, J, T, wdExportDocumentWithMarkup, _ | |
False, False, wdExportCreateHeadingBookmarks, True, False, False | |
J = T | |
T = T + xPages | |
Next | |
T = J + modResult | |
J = J + 1 | |
ActiveDocument.ExportAsFixedFormat xPathStr & "\Page_" & resultValue & ".pdf", _ | |
wdExportFormatPDF, False, wdExportOptimizeForPrint, wdExportFromTo, J, T, wdExportDocumentWithMarkup, _ | |
False, False, wdExportCreateHeadingBookmarks, True, False, False | |
End If | |
End If | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
this is to run the code inside a online compiler
Public Module Program
Public Sub Main(args() As string)
Dim xPathStr As String
Dim xDictoryStr As String
Dim xStartPage, xEndPage, xPages As Long
Dim xStartPageStr, xEndPageStr, xPagesStr As String
Dim xScaledEndPage As Long
Dim xFileDlg As String
End Module