VBA: función “Pluralize” (by Mike Wolfe)

Option Compare Database
Option Explicit
'---------------------------------------------------------------------------------------
' Procedure : Pluralize
' Author    : Mike
' Date      : 10/21/2010 - 7/24/2014
' Adapted   : Luis Viadel | https://cowtechnologies.net
' Date      : 03/04/2022
' Purpose   : Formats a phrase to make verbs agree in number.
' Notes     : To substitute the absolute value of the number for numbers that can be
'               positive or negative, use a custom number format that includes
'               both positive and negative formats; e.g., "#;#".
' Usage     : Msg = "There [is/are] # record[s].  [It/They] consist[s/] of # part[y/ies] each."
'>>> Pluralize("There [is/are] # record[s].  [It/They] consist[s/] of # part[y/ies] each.", 1)
' There is 1 record.  It consists of 1 party each.
'>>> Pluralize("There [is/are] # record[s].  [It/They] consist[s/] of # part[y/ies] each.", 6)
' There are 6 records.  They consist of 6 parties each.
'>>> Pluralize("There was a {gain/loss} of # dollar[s].", -50, "#", "#;#")
' There was a loss of 50 dollars.
'>>> Pluralize("I {won/lost} # at the fair.  {I was thrilled./I'll never learn.}", 20, "#", "Currency")
' I won $20.00 at the fair.  I was thrilled.
'>>> Pluralize("There [is/are] # {more/less} finger[s] on his hand after the surgery.", -1, "#", "#;#")
' There is 1 less finger on his hand after the surgery.
'---------------------------------------------------------------------------------------
' Adaptation purpose  : adapt the function to the Spanish language
'                        in English: Pluralize("You gambled your life savings and {won/won/lost} #.",i, ,"#,##0 €;#,##0 €;nothing"):Next i
'                        in spanish: Pluralize("Apostaste los ahorros de tu vida y {ganaste/no ganaste/perdiste} #.",i, ,"#,##0 €;#,##0 €;nada"):Next i
'---------------------------------------------------------------------------------------

Function Pluralize(Text As String, Num As Variant, _
                   Optional NumToken As String = "#", _
                   Optional NumFormat As String = "")
    
    Const OpeningBracket As String = "\["
    Const ClosingBracket As String = "\]"
    Const OpeningBrace As String = "\{"
    Const ClosingBrace As String = "\}"
    Const DividingSlash As String = "/"
    Const CharGroup As String = "([^\]]*)"  'Group of 0 or more characters not equal to closing bracket
    Const BraceGroup As String = "([^\/\}]*)" 'Group of 0 or more characters not equal to closing brace or dividing slash

    Dim IsPlural As Boolean, IsNegative As Boolean, IsZero As Boolean
    
    If IsNumeric(Num) Then
        IsPlural = (Abs(Num) <> 1)
        IsNegative = (Num < 0)
        IsZero = (Num = 0) 'Added sapanish adaptation
    End If
    
    Dim Msg As String, Pattern As String
    Msg = Text
    
    'Replace the number token with the actual number
    Msg = Replace(Msg, NumToken, Format(Num, NumFormat))
    
    'Replace [y/ies] style references
    Pattern = OpeningBracket & CharGroup & DividingSlash & CharGroup & ClosingBracket
    Msg = RegExReplace(Pattern, Msg, "$" & IIf(IsPlural, 2, 1))
    
    'Replace [s] style references
    Pattern = OpeningBracket & CharGroup & ClosingBracket
    Msg = RegExReplace(Pattern, Msg, IIf(IsPlural, "$1", ""))
        
    'Replace {gain/gain/loss} style references (spanish friendly)
    Pattern = OpeningBrace & BraceGroup & DividingSlash & BraceGroup & DividingSlash & BraceGroup & ClosingBrace
    Msg = RegExReplace(Pattern, Msg, "$" & IIf(IsZero, 2, (IIf(IsNegative, 3, 1))))
       
    Pluralize = Msg
    
End Function


'---------------------------------------------------------------------------------------
' Procedure : RegExReplace
' Author    : Mike Wolfe <mike@nolongerset.com>
' Date      : 11/4/2010
' Source    : https://nolongerset.com/now-you-have-two-problems/
' Purpose   : Attempts to replace text in the TextToSearch with text and back references
'               from the ReplacePattern for any matches found using SearchPattern.
' Notes     - If no matches are found, TextToSearch is returned unaltered.  To get
'               specific info from a string, use RegExExtract instead.
'>>> RegExReplace("(.*)(\d{3})[\)\s.-](\d{3})[\s.-](\d{4})(.*)", "My phone # is 570.555.1234.", "$1($2)$3-$4$5")
'My phone # is (570)555-1234.
'---------------------------------------------------------------------------------------
'
Function RegExReplace(SearchPattern As String, TextToSearch As String, ReplacePattern As String, _
                      Optional GlobalReplace As Boolean = True, _
                      Optional IgnoreCase As Boolean = False, _
                      Optional MultiLine As Boolean = False) As String
Dim RE As Object

    Set RE = CreateObject("vbscript.regexp")
    With RE
        .MultiLine = MultiLine
        .Global = GlobalReplace
        .IgnoreCase = IgnoreCase
        .Pattern = SearchPattern
    End With
    
    RegExReplace = RE.Replace(TextToSearch, ReplacePattern)
    
End Function