View Single Post
 
Old 06-06-2023, 09:12 AM
mery mery is offline Windows 10 Office 2013
Novice
 
Join Date: Jun 2023
Posts: 2
mery is on a distinguished road
Default

Solved
Code:
Sub sample2()


Dim srchRng As Range
Dim a As String, b As String, c As String

Set srchRng = ActiveDocument.Content


With srchRng.Find
    .Text = "ID:"
    .Execute
    If .Found = True Then
        Dim numberstart As Long
        numberstart = Len(srchRng.Text) + 1
        srchRng.MoveEndUntil Cset:=","

        Dim mynum As String
        mynum = Mid(srchRng.Text, numberstart)
    End If
End With
c = mynum

For nSectionNum = 1 To ActiveDocument.Sections.Count
Selection.GoTo What:=wdGoToSection, Which:=wdGoToNext, Name:=nSectionNum
ActiveDocument.Sections(nSectionNum).Range.Copy
     

Next nSectionNum
  

Dim oRng As Range
Dim oPara As Paragraph
Dim b As String, a As String

Set oPara = ActiveDocument.Paragraphs(5)
Set oRng = oPara.Range
oRng.End = oRng.End - 1
b = oRng.Text

Set oPara = ActiveDocument.Paragraphs(2)
Set oRng = oPara.Range
oRng.End = oRng.End - 1
a = oRng.Text

  
ActiveDocument.ExportAsFixedFormat OutputFileName:="E:\test\" & b & " " & a & " " & "Sample" & "" & c & ".pdf", _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False



End Sub
Reply With Quote