Created
July 23, 2017 13:19
-
-
Save boyboi86/cd7b12dada808bd56bc0698444238118 to your computer and use it in GitHub Desktop.
MS word convert to PDF and save
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
Option Explicit | |
Sub AllSectionsToSubDoc() | |
Dim x As Long | |
Dim Sections As Long | |
Dim Doc As Document | |
Application.ScreenUpdating = False | |
Application.DisplayAlerts = False | |
Set Doc = ActiveDocument | |
Sections = Doc.Sections.Count | |
For x = Sections - 1 To 1 Step -1 | |
Doc.Sections(x).Range.Copy | |
Documents.Add | |
ActiveDocument.Range.Paste | |
ActiveDocument.SaveAs (Doc.Path & "\" & x & ".doc") | |
ActiveDocument.Close False | |
Next x | |
Application.ScreenUpdating = True | |
Application.DisplayAlerts = True | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Sub merge1record_at_a_time()'
' merge1record_at_a_time Macro
'
'
Dim fd As FileDialog
Application.ScreenUpdating = False
MainDoc = ActiveDocument.Name
ChangeFileOpenDirectory SelectedPath
For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
docname = .DataFields("ASP_Print").Value & ".docx" ' ADDED CODE
End With
.Execute Pause:=False
Application.ScreenUpdating = False
ActiveDocument.ExportAsFixedFormat OutputFileName:=docName, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _ 'set OpenAfterExport to False so the PDF files won't open after mail merge
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
Application.ScreenUpdating = True
End Sub