Funciones vba para permitir captura de texto, números o números con decimales en Formularios de Excel

image

En un artículo anterior habíamos visto cómo restringir el ingreso de texto o números mediante macros en Excel. En aquella ocasión desarrollé dos procedimientos, uno para aceptar sólo ingreso de texto y otro para aceptar sólo ingreso de números en un TextBox.

Haciendo uso de los mismos procedimientos, ahora convertidos en funciones, es que veremos un ejemplo más, y es, permitir sólo números con un punto decimal. Veamos cómo funciona:

Permitir sólo texto

La función SoloTexto recorre el texto ingresado “al vuelo” y mediante la función IsText, hace un reemplazo de lo que “no es texto” por un carácter vacío, es decir, “”. La función se llama mediante el evento _Change del TextBox.

SoloTexto

Figura 1. Permitir ingreso de texto en TextBox.

Private Sub txtTexto_Change()
'
    Me.txtTexto.Value = SoloTexto(Me.txtTexto.Value)
    '
End Sub
Permitir sólo números

También llamada desde el evento _Change, la función SoloNumero restringe el ingreso de todos los caracteres menores al 48 y mayores al 57. Con la función =CARACTER(48) comprobamos que es igual a 0 y con =CARACTER(48) obtenemos el 9.

SoloNumeros

Figura 2. Permitir sólo ingreso de números en TextBox.

Private Sub txtNumero_Change()
'
    Me.txtNumero.Value = SoloNumero(Me.txtNumero.Value)
    '
End Sub
Permitir números con un punto decimal

La función SoloNumeroDecimal funcionará de manera similar a SoloNumero, con la salvedad de que permitirá el ingreso de un punto. Si intentamos ingresar un segundo punto, la función no lo permitirá. Estos será útil cuando queremos capturar cantidades numéricas y decimales.

NumeroDecimal

Figura 3. Permitir ingreso de números con un punto decimal.

Private Sub txtNumeroDecimal_Change()

    Me.txtNumeroDecimal.Value = SoloNumeroDecimal(Me.txtNumeroDecimal.Value)
    '
End Sub

Código de la macro

Ubicación: Módulo Validaciones

Option Private Module
'---------------------------------------------------------------------------------------
' Module    : Functions
' Author    : MVP, Sergio Alejandro Campos
' Date      : 21/sep/2015
' Purpose   : Funciones para permitir sólo texto, número y números con decimales
'---------------------------------------------------------------------------------------
'
Sub MostrarFormulario()
'
    frmValidaciones.Show
    '
End Sub
'
Function SoloTexto(Texto As Variant)
'
    Dim Caracter As Variant
    Dim Largo As String
    On Error Resume Next
    Largo = Len(Texto)
    '
    For i = 1 To Largo
        Caracter = CInt(Mid(Texto, i, 1))
        '
        If Caracter <> "" Then
            If Not Application.WorksheetFunction.IsText(Caracter) Then
                Texto = Replace(Texto, Caracter, "")
                SoloTexto = Texto
            Else
            End If
        End If
        '
    Next i
    '
    SoloTexto = Texto
    On Error GoTo 0
    '
End Function
'
Function SoloNumero(Texto As Variant)
'
    Dim Caracter As Variant
    Dim Largo As Integer
    On Error Resume Next
    Largo = Len(Texto)
    '
    For i = 1 To Largo
        Caracter = Mid(CStr(Texto), i, 1)
        '
        If Caracter <> "" Then
            If Caracter < Chr(48) Or Caracter > Chr(57) Then
                Texto = Replace(Texto, Caracter, "")
                SoloNumero = Texto
            Else
            End If

        End If
        '
    Next i
    '
    SoloNumero = Texto
    On Error GoTo 0
    '
End Function
'
Function SoloNumeroDecimal(Texto As Variant)
'
    Dim Caracter As Variant
    Dim Largo As Integer
    On Error Resume Next
    Punto = 0
    Largo = Len(Texto)
    '
    For i = 1 To Largo
        Caracter = Mid(CStr(Texto), i, 1)
        If Caracter <> "" Then
            '
            If Caracter = Chr(46) Then
                Punto = Punto + 1
                If Punto > 1 Then
                    Texto = WorksheetFunction.Replace(Texto, i, 1, "")
                    SoloNumeroDecimal = Texto
                    Punto = 0
                End If
            Else
                If Caracter < Chr(48) Or Caracter > Chr(57) Then
                    Texto = Replace(Texto, Caracter, "")
                    SoloNumeroDecimal = Texto
                Else
                End If
                '
            End If
            '
        End If
    Next i
    '
    SoloNumeroDecimal = Texto
    On Error GoTo 0
    '
End Function

Anexos

:: DESCARGAR Función para restringir texto o números – EXCELeINFO.rar

También te podría gustar...