CHUYỂN PDF THEO SỐ TRANG WORD

Sub SaveEachPageAsPDF()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim PageCount As Integer
    Dim i As Integer
    Dim PDFPath As String
    Dim PDFFileName As String
    Dim pageText As String
    Dim regex As Object
    Dim match As Object
    Dim prefix As String
    
    ' T?o m?t ?ng d?ng Word m?i
    Set WordApp = CreateObject("Word.Application")
    
    ' S? d?ng tài li?u Word hi?n t?i
    Set WordDoc = ActiveDocument
    
    ' L?y s? lu?ng trang trong tài li?u Word
    PageCount = WordDoc.ComputeStatistics(wdStatisticPages)
    
    ' T?o d?i tu?ng Regular Expression d? tìm do?n "S?: xxx"
    Set regex = CreateObject("VBScript.RegExp")
    regex.IgnoreCase = True
    regex.Global = True
    regex.Pattern = "S?:\s*(\S+)"
    
    ' L?y n?i dung trang d?u tiên và tìm ki?m "S?: xxx"
    pageText = WordDoc.Range(Start:=WordDoc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=1).Start, _
                             End:=WordDoc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=2).Start).Text
    
    ' Tìm ki?m "S?: ..." trên trang d?u tiên
    Set match = regex.Execute(pageText)
    
    If match.Count > 0 Then
        ' N?u tìm th?y "S?: xxx", l?y giá tr? và c?t 13 ký t? d?u tiên làm ti?n t? cho tên t?p PDF
        prefix = Left(match(0).SubMatches(0), 13) ' L?y 13 ký t? d?u tiên
    Else
        ' N?u không tìm th?y, s? d?ng "Page_" làm tên m?c d?nh
        prefix = "Page"
    End If
    
    ' L?p qua t?ng trang và luu thành t?p PDF riêng l?
    For i = 1 To PageCount
        ' T?o tên t?p PDF v?i d?nh d?ng "S?: xxx-01", "S?: xxx-02", v.v.
        PDFFileName = ActiveDocument.Path & Application.PathSeparator & prefix & "-" & Format(i, "00") & ".pdf"
        
        ' Xu?t trang hi?n t?i thành t?p PDF
        WordDoc.ExportAsFixedFormat OutputFileName:=PDFFileName, _
            ExportFormat:=wdExportFormatPDF, _
            Range:=wdExportFromTo, From:=i, To:=i, _
            Item:=wdExportDocumentContent, _
            IncludeDocProps:=False, _
            KeepIRM:=False, _
            CreateBookmarks:=wdExportCreateNoBookmarks, _
            DocStructureTags:=False, _
            BitmapMissingFonts:=False, _
            UseISO19005_1:=False
        
        ' Hi?n th? thông báo v? t?p PDF dã luu
        ' MsgBox "Trang " & i & " dã du?c luu thành " & PDFFileName
    Next i
    
    ' Ðóng ?ng d?ng Word
    WordApp.Quit
    
    ' Gi?i phóng b? nh?
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub