VBA functions to print a doc without last page, to print last page only, and to add nbsp between numbers and strings

gistfile1.txt

' Друк документа без останньої сторінки
Sub PrintWithoutLastPage()
    Dim totalPages As Integer
    totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
    
    If totalPages > 1 Then
        ActiveDocument.PrintOut Range:=wdPrintRangeOfPages, Pages:="1-" & totalPages - 1, Copies:=1
    Else
        MsgBox "The document has only one page. Printing is canceled.", vbExclamation, "Print Without Last Page"
    End If
End Sub

' Друк останньої сторінки документа
Sub PrintLastPage()
    Dim totalPages As Integer
    totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
    
    If totalPages >= 1 Then
        ActiveDocument.PrintOut Range:=wdPrintRangeOfPages, Pages:=CStr(totalPages), Copies:=1
    Else
        MsgBox "The document has no pages to print.", vbExclamation, "Print Last Page"
    End If
End Sub

' Замінити пробіли між числами і текстом, а також між № і наступним символом, на непереносні
Sub ReplaceNumberWordSpaces()
  Dim rng As Range
  Set rng = ActiveDocument.Content

  ' Exclude dates (e.g. 15.02.2025), times (04:00), and years (2025 року)
  With rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "([0-9]) ([A-Za-zА-Яа-я])"
    .Replacement.Text = "\1^s\2"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  
  ' Add nbsp between № and following character (letter or digit)
  Set rng = ActiveDocument.Content
  With rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "(№) ([A-Za-zА-Яа-я0-9])"
    .Replacement.Text = "\1^s\2"
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
  
  ' Reverse exclude А4955
  With rng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "(А4955)^s"
    .Replacement.Text = "\1 "
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
  End With
End Sub

' Åêñïîðòóâàòè êîæíó ñòîð³íêó â îêðåìèé pdf-ôàéë
Sub ExportEachPageAsPDF()
    Dim totalPages As Integer
    Dim i As Integer
    Dim baseName As String
    Dim outputPath As String
    Dim fullOutputName As String

    ' Get document name without extension
    baseName = Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1)

    ' Get output folder (same as DOCX)
    outputPath = ActiveDocument.Path
    If outputPath = "" Then
        MsgBox "Please save the document first.", vbExclamation
        Exit Sub
    End If

    ' Count total pages
    totalPages = ActiveDocument.ComputeStatistics(wdStatisticPages)

    ' Loop through pages and export each as PDF
    For i = 1 To totalPages
        fullOutputName = outputPath & "\" & baseName & "_page" & i & ".pdf"
        
        ActiveDocument.ExportAsFixedFormat _
            OutputFileName:=fullOutputName, _
            ExportFormat:=wdExportFormatPDF, _
            Range:=wdExportFromTo, _
            From:=i, To:=i, _
            Item:=wdExportDocumentContent, _
            IncludeDocProps:=False, _
            KeepIRM:=True, _
            CreateBookmarks:=wdExportCreateNoBookmarks, _
            DocStructureTags:=False, _
            BitmapMissingFonts:=True, _
            UseISO19005_1:=False
    Next i

    MsgBox "Done! " & totalPages & " PDFs saved to:" & vbCrLf & outputPath
End Sub

' Çáåðåãòè äîêóìåíò îäíî÷àñíî ó docx ³ pdf
Sub SaveAsDocxAndPdf()
    '
    ' SaveAsDocxAndPdf Macro
    ' Saves the current document as both DOCX and PDF with the same filename
    '
    
    Dim doc As Document
    Dim filePath As String
    Dim fileName As String
    Dim fileNameWithoutExt As String
    Dim folderPath As String
    
    ' Get the active document
    Set doc = ActiveDocument
    
    ' Check if document has been saved before
    If doc.Path = "" Then
        ' Document hasn't been saved yet, prompt user for location
        Dim fd As FileDialog
        Set fd = Application.FileDialog(msoFileDialogSaveAs)
        
        With fd
            .Title = "Save Document As"
            .FilterIndex = 1
            .InitialFileName = "Document"
            If .Show = -1 Then
                filePath = .SelectedItems(1)
            Else
                ' User cancelled the dialog
                Exit Sub
            End If
        End With
        
        ' Extract folder path and filename without extension
        folderPath = Left(filePath, InStrRev(filePath, "\"))
        fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
        fileNameWithoutExt = Left(fileName, InStrRev(fileName, ".") - 1)
        
    Else
        ' Document already saved, use existing path and name
        folderPath = doc.Path & "\"
        fileNameWithoutExt = Left(doc.Name, InStrRev(doc.Name, ".") - 1)
        If fileNameWithoutExt = "" Then
            fileNameWithoutExt = doc.Name
        End If
    End If
    
    ' Turn off alerts to prevent overwrite prompts
    Application.DisplayAlerts = False
    
    On Error GoTo ErrorHandler
    
    ' Save as DOCX
    doc.SaveAs2 fileName:=folderPath & fileNameWithoutExt & ".docx", _
               FileFormat:=wdFormatXMLDocument
    
    ' Save as PDF
    doc.ExportAsFixedFormat OutputFileName:=folderPath & fileNameWithoutExt & ".pdf", _
                           ExportFormat:=wdExportFormatPDF, _
                           OpenAfterExport:=False, _
                           OptimizeFor:=wdExportOptimizeForPrint, _
                           Range:=wdExportAllDocument, _
                           Item:=wdExportDocumentContents, _
                           IncludeDocProps:=True, _
                           KeepIRM:=True, _
                           CreateBookmarks:=wdExportCreateNoBookmarks, _
                           DocStructureTags:=True, _
                           BitmapMissingFonts:=True
    
    ' Turn alerts back on
    Application.DisplayAlerts = True
    
    ' Show success message
    MsgBox "Document saved successfully as:" & vbNewLine & _
           "• " & fileNameWithoutExt & ".docx" & vbNewLine & _
           "• " & fileNameWithoutExt & ".pdf" & vbNewLine & vbNewLine & _
           "Location: " & folderPath, vbInformation, "Save Complete"
    
    Exit Sub
    
ErrorHandler:
    ' Turn alerts back on in case of error
    Application.DisplayAlerts = True
    
    ' Show error message
    MsgBox "An error occurred while saving the document:" & vbNewLine & _
           "Error: " & Err.Description, vbCritical, "Save Error"
End Sub