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
            Funciones de dominio de Alba
            17/03/2023
            Moda, mediana y algo más
            20/03/2023
            Mostrar todos

            Función que convierte cualquier carácter a texto puramente ASCII (Access VBA)

            Publicado por Rafael Andrada
            Categorías
            • Un trocito de código
            Etiquetas
            • Access
            • VBA
            • Nivel
            • Propósito
            • Código
            • Ver también

            Función que convierte cualquier carácter a texto puramente ASCII (Access VBA)

            Nivel

            Medio

            Propósito

            Pasar una cadena de texto que contiene acentos, tildes, acentos circunflejos (palabras francesas), eñes, diéresis (común en el alemán), cedillas y otros dicríticos, a texto puramente ASCII.

            Código

            Public Function mcstrConvertToAscii(ByVal strString As String, ByVal blnMantenerFormatoMayúscula As Boolean, Optional ByVal blnMantenerEspacios As Boolean, Optional ByVal strCarácterAObviar As String) As String
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            ' Fuente            : https://access-global.net/funcion-que-convierte-cualquier-caracter-a-texto-puramente-ascii-access-vba
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            ' Título            : mcstrConvertToAscii
            ' Autor             : Rafael .:McPegasus:. Copyright ©1999-2007 for Puzzle
            ' Actualizado       : 20/07/2021
            ' Propósito         : Pasar una cadena de texto que contiene acentos, tildes, acentos circunflejos (palabras francesas), eñes, diéresis (común en el alemán), cedillas y otros dicríticos, a texto puramente ASCII.
            ' Retorno           : Una cadena de texto con sólo caracteres ASCII.
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            ' Argumentos        : La sintaxis del procedimiento o función consta de los siguientes argumentos:
            '                     Parte                 Modo           Descripción
            '                     --------------------------------------------------------------------------------------------------------------------------
            '                     strString             Obligatorio    El valor String especifica una cadena de texto que contiene acentos, acentos circunflejos (palabras francesas), eñes, diéresis (común en el alemán), cedillas y otros dicríticos.
            '                     blnMantenerFormatoMayúscula  Opcional El valor Boolean especifica si se desea mantener en mayúscula los caracteres que así estén de origen.
            '                     [ blnMantenerEspacios ]  Opcional    El valor Boolean especifica si se desea mantener los espaciones o eliminarlos.
            '                     [ strCarácterAObviar ]  Opcional     El valor String especifica si se desea no sustituir algún caracter.
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            ' Sobre Referenciar : El referenciar una librería externa nos permite seleccionar los objetos de otra aplicación que se desea que estén disponibles en nuestro código. También acceder a sus métodos utilizar las constantes.
            '                     En caso de ser opcional podemos seguir utilizándolo aunque las constantes hay que sustituirlas por su valor, normalmente numérico.
            '                     Más información: https://support.microsoft.com/es-es/office/add-object-libraries-to-your-visual-basic-project-ed28a713-5401-41b0-90ed-b368f9ae2513
            ' Referencia        : Opcional. Microsoft Scripting Runtime (c:\Windows\SysWOW64\scrrun.dll)
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            'Test:              : Para adaptar este código en tu aplicación puedes basarte en este procedimiento test. Copiar todo el procedimiento desde el Sub hasta el End Sub
            '                     al portapapeles y pega en el editor de VBA de tu aplicación MS Access. Descomentar todas las líneas que nos interese (se aconseja seleccionar
            '                     todas las líneas del ejemplo y utilizar el botón 'Bloque sin comentarios' de la barra de herramientas 'Edición').
            '                     Pulsar F5 para ver su funcionamiento.
            '
            '                         portapapeles y pega en el editor de VBA. Descomentar la línea que nos interese y pulsar F5 para ver su funcionamiento.
            '
            '    Sub mcstrConvertToAscii_test()
            '
            '        Dim strCadena                               As String
            '
            '
            '        strCadena = "€ÍCœ€amión€ÓáÁÉé-"
            '
            '        Debug.Print
            '        Debug.Print "Original: " & strCadena
            '        Debug.Print "Mayúscu.: " & mcstrConvertToAscii(strCadena, True)               'Mantener las mayúsculas.
            '        Debug.Print "Minúscu.: " & mcstrConvertToAscii(strCadena, False)              'Convertir a minúsculas.
            '
            '    End Sub
            '</Test>
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            ' Importante        : A comienzo en el módulo, comprobar que está la declaración "Option Compare Binary" para que el código distinga entre minúsculas y mayúsculas.
            '-----------------------------------------------------------------------------------------------------------------------------------------------
            
                Dim blnCarácterNoConvertibleAMinúsculas     As Boolean
            
                Dim intCount                                As Integer
                
                Dim lngString                               As Long
                
                Dim strCaracter                             As String
                Dim strFind                                 As String
                Dim strWork                                 As String
            
            
                lngString = Len(strString)
                
                If Not lngString = 0 Then
                
                    strWork = strString
            
                    For intCount = 1 To lngString
                        blnCarácterNoConvertibleAMinúsculas = False
                        strCaracter = ""
                        strFind = Mid(strString, intCount, 1)
                
                        Select Case strFind
                            Case "\\", "¨", "º", "~", "#", "@", "²", "³", "|", "!", "\", "¤", "¬", "«", "·", "¥", "$", "©", "®", "¯", "±", "°", "%", "¦", "§", "&", "/"
                                strCaracter = ""
                                blnCarácterNoConvertibleAMinúsculas = True
                                
                            Case "(", ")", "?", "'", "¡", "¿", "[", "^", "`", "]", "+", "}", "{", "¨", "´", ">", "< ", ";", ",", ":", ".", "¢", "£", """"
                                strCaracter = ""
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Á", "À", "Â", "Ä", "Ã", "Å", "Æ"
                                strCaracter = "A"
                            
                            Case "á", "à", "â", "ä", "ã", "å", "æ", "ª"
                                strCaracter = "a"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "É", "È", "Ê", "Ë", "Ð", "€"
                                strCaracter = "E"
                            
                            Case "é", "è", "ê", "ë"
                                strCaracter = "e"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Í", "Ì", "Î", "Ï"
                                strCaracter = "I"
                            
                            Case "í", "ì", "î", "ï"
                                strCaracter = "i"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Ó", "Ò", "Ô", "Ö", "Õ", "Ø", "Œ"
                                strCaracter = "O"
             
                            Case "ó", "ò", "ô", "ö", "õ", "ð", "œ"
                                strCaracter = "o"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Ú", "Ù", "Û", "Ü"
                                strCaracter = "U"
                            
                            Case "ú", "ù", "û", "ü"
                                strCaracter = "u"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Ð"
                                strCaracter = "D"
                            
                            Case "Š"
                                strCaracter = "S"
                            
                            Case "Š"
                                strCaracter = "S"
                            
                            Case "š"
                                strCaracter = "s"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Ý"
                                strCaracter = "Y"
                            
                            Case "ý", "ÿ"
                                strCaracter = "y"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Ñ"
                                strCaracter = "N"
                            
                            Case "ñ"
                                strCaracter = "n"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Ç"
                                strCaracter = "C"
                            
                            Case "ç"
                                strCaracter = "c"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "Ž"
                                strCaracter = "Z"
                            
                            Case "ž"
                                strCaracter = "z"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "-"
                                strCaracter = "-"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case "_"
                                strCaracter = "_"
                                blnCarácterNoConvertibleAMinúsculas = True
                            
                            Case " "
                                If blnMantenerEspacios Then
                                    strCaracter = " "
                                
                                Else
                                    strCaracter = "-"
                                
                                End If
                                blnCarácterNoConvertibleAMinúsculas = True
            
                            Case Else
                                'Comprobar que sean números, en este caso no covertir a minúsculas.
                                If Asc(strFind) > 47 And Asc(strFind) < 58 Then
                                    strCaracter = strFind
                                    blnCarácterNoConvertibleAMinúsculas = True
                                    
                                End If
                        
                                'En caso de ser carácteres comprendidos entre A-Z (65-90) o a-z (97-122).
                                If Asc(strFind) > 64 And Asc(strFind) < 91 Then
                                    strCaracter = strFind
                                    
                                End If
                                
                                If Asc(strFind) > 96 And Asc(strFind) < 123 Then
                                    strCaracter = strFind
                                    blnCarácterNoConvertibleAMinúsculas = True
                                    
                                End If
                        End Select
                        
                        If Not strFind = strCarácterAObviar Then
                            If Not blnMantenerFormatoMayúscula Then
                                If Not blnCarácterNoConvertibleAMinúsculas Then
                                    If Not strCaracter = "" Then
                                        strCaracter = Chr(Asc(strCaracter) + 32)
                                            
                                    End If
                                End If
                            End If
                        End If
                        
                        strWork = Replace(strWork, strFind, strCaracter)
                    
                    Next intCount
                End If
            
                strWork = Replace(strWork, "----", "-")
                strWork = Replace(strWork, "---", "-")
                strWork = Replace(strWork, "--", "-")
                
                If Not strCarácterAObviar = "-" Then
                    strWork = Replace(strWork, "-", " ")
                    
                End If
            
                mcstrConvertToAscii = Trim(strWork)
            
            End Function

            Ver también

            • Ir a repositorio en GitHub
            Compartir
            0
            Rafael Andrada
            Rafael Andrada

            Entradas relacionadas

            24/03/2022

            Obtener la fecha del primer día de la semana o último día de la semana en Access VBA


            Leer más
            11/03/2022

            Actualizar una conexión ODBC en tiempo de ejecución


            Leer más
            28/02/2022

            Crear un acceso directo personalizado en el escritorio


            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