Блог

У меня есть два макроскрипта, оба работают идеально индивидуально! Но я хочу объединить их и иметь 1 скрипт. По сути, я хочу сохранить все страницы в документе WORD (например, 100 страниц) в формате PDF и назвать каждый файл в соответствии с 3-й строкой каждой страницы. Итак, первый сценарий следующий, который преобразуется в PDF:

 
Sub SaveAsSeparatePDFs()

Dim strDirectory As String, strTemp As String, ipgEnd As Integer
Dim iPDFnum As Integer, i As Integer

strTemp = InputBox("How many pages is included?" amp; vbNewLine amp; "(ex: 60)")
ipgEnd = CInt(strTemp)
strDirectory = Environ("USERPROFILE") amp; "Desktop"
        
iPDFnum = 1
For i = 1 To ipgEnd
    
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        strDirectory amp; "User--" amp; iPDFnum amp; FirstPara amp; ".pdf", ExportFormat:=wdExportFormatPDF, _
        OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
        wdExportFromTo, From:=i, To:=i   1, Item:=wdExportDocumentContent, _
        IncludeDocProps:=False, KeepIRM:=False, CreateBookmarks:= _
        wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
    iPDFnum = iPDFnum   1
    
    i = i   1
Next i
End
End Sub
 

И вот второй скрипт, который переименовывает каждый файл в соответствии с третьей строкой WORD doc:

 Sub SaveAsWordAndRename()

Dim oSection As Section
Dim r As Range
Dim TempDoc As Document
Dim FirstPara As String

Dim strDirectory As String, strTemp As String, ipgEnd As Integer
Dim iPDFnum As Integer, i As Integer

For Each oSection In ActiveDocument.Sections
Set r = oSection.Range
r.End = r.End - 1
Set TempDoc = Documents.Add
With TempDoc
.Range = r
FirstPara = r.Paragraphs(3).Range.Text
FirstPara = Left(FirstPara, Len(FirstPara) - 1)
.SaveAs FileName:=FirstPara amp; ".doc"
.Close
End With
Set r = Nothing
Set TempDoc = Nothing
Next
End Sub