Logo_Access_global_380x114Favicon_Access_global_180x180Logo_Access_global_380x114Logo_Access_global_380x114
  • Home
  • University
    • Destellos formativos
  • Labs
  • TV
  • Secciones
    • El mundo de Access
    • Explorando VBA
      • Artículos sobre VBA
      • Un trocito de código
    • Entrevistas
      • Profesionales de Access
    • El rincón de Excel
    • Bases de datos
      • MS SQL
      • MySQL
      • postgreSQL
      • SQLite
    • Clases magistrales
    • Utilidades hechas con Access
  • Access en el mundo
  • ¿Quiénes somos?
  • Cómo colaborar
  • Eventos
✕
            No hay resultados Mostrar todos los resultados
            Access: crea un sistema de ayuda
            02/04/2022
            Access: Cuadro de Lista con selección múltiple
            04/04/2022
            Mostrar todos

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

            Publicado por Luis Viadel
            Categorías
            • Destellos formativos
            Etiquetas
            • Mike Wolfe
            • VBA
            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
            
            ¡Ver en el repositorio!
            Compartir
            13
            Luis Viadel
            Luis Viadel

            Entradas relacionadas

            30/03/2023

            Tratamiento de errores: compilación condicional


            Leer más
            29/03/2023

            Tratamiento de errores: errores personalizados


            Leer más
            28/03/2023

            Tratamiento de errores: Resume


            Leer más

            Deja una respuesta Cancelar la respuesta

            Tu dirección de correo electrónico no será publicada. Los campos obligatorios están marcados con *

            ETIQUETAS

            Access API BD Botones ComboBox Consultas CountOfLines CStr Diseño DoCmd Excel Exportar Fecha FileSystemObject Filtros For Each...Next Formulario Formularios Funciones Funciones de dominio GetFolder GetWindowRect Google maps Informes InStr Kill Left Listbox Mid Módulos Node ProcCountLines Procedimientos ProcOfLine References Replace Ribbon RunCommand Seguridad Split SysCmd Tablas TreeView VBA VBIDE

            ÚLTIMAS ENTRADAS

            • 0
              Tratamiento de errores: compilación condicional
              30/03/2023
            • 0
              Tratamiento de errores: errores personalizados
              29/03/2023

            ¿QUIERES PUBLICITAR TU EMPRESA AQUÍ?

            SUSCRÍBETE A NUESTRO
            NEWSLETTER

            Recibirás información puntual sobre el mundo de Access y VBA

            ¡Próximamente!

            Promovemos el uso de Access y de la programación en VBA en todo el mundo

            Centro de conocimiento


            Toda la sabiduría de los mejores programadores de Access y VBA a tu alcance.

            Legal

            Política de privacidad

            Condiciones de uso

            Condiciones del redactor

            ®Access Global 2021 | All right reserved
                      No hay resultados Mostrar todos los resultados