Mis utilidades para Visual Basic

Publicado: 20/Abr/97 (revisado: 4-Sep-98)
No están todas las que son, pero...
Aquí tienes un link para las utilidades puestas el 13-Jul-97
Este link te llevará a una página con más utilidades (casi todas)


Estas son algunas de las funciones y procedimientos que suelo usar de forma genérica en mis programas.
Aquí no incluyo las que ya están puestas... (algún día lo haré, aunque sea mediante links a dónde están).

  1. Quitar de una cadena los Caracteres indicados.
  2. Rellenar una cadena con caracteres hasta completar una longitud dada
  3. Formatear un número a una longitud dada y cambiar los signos de puntuación al indicado
  4. Cálculo de la letra del NIF
  5. Cambiar los caracteres extraños por ? (para usar en las consultas a bases de datos con LIKE)

Quitar de una cadena los Caracteres indicados.

Esta función recibe dos cadenas, la primera es la que se quiere procesar y la segunda los caracteres que se quieren quitar de la primera, ésta última al ser opcional, si no se indica se asume que son los caracteres: punto, coma y espacio.

NOTA: Si quieres ver otra versión de esta función para sustituir ciertos caracteres por otros, pulsa este link.

Ejemplo:
sRet$ = QuitarCaracter("Hola Mundo", "Mundo ")
Devolverá: "Hla"
No es un fallo, es que comprueba los caracteres uno a uno.

Public Function QuitarCaracter(ByVal sValor As String, Optional sCaracter) As String
    '----------------------------------------------
    ' Quitar los símbolos               ( 5/Jun/96)
    '----------------------------------------------
    Dim i As Integer
    Dim j As Integer
    Dim sTmp As String
        
    'Si no se especifican los caracteres a quitar
    If IsMissing(sCaracter) Then
        sCaracter = "., "       'Para números
    End If
    
    sTmp = ""
    For i = 1 To Len(sValor)
        If InStr(sCaracter, Mid$(sValor, i, 1)) = 0 Then
            sTmp = sTmp & Mid$(sValor, i, 1)
        End If
    Next
    QuitarCaracter = sTmp
End Function

Rellenar una cadena con caracteres hasta completar una longitud dada.

Esta función devolverá una cadena con la longitud indicada en el segundo parámetro, el tercer parámetro se usa para justificarla de tres formas posibles: izquierda (0), derecha (1), centrado (2)
Si la longitud original de la cadena es mayor que lo especificado en el segundo parámetro, y éste es mayor que cinco, se mostrarán tres puntos suspensivos, para avisar que lo que se muestra no es todo lo que hay...

Public Function Rellena(ByVal sCadena As String, iLen As Integer, Optional DerIzq) As String
    'Si no se especifica DerIzq, se justifica a la Izquierda    (20/Oct/96)
    'Si se especifica, un valor 0 lo justifica a la Izquierda, otro cualquiera a la Derecha
    'Izquierda 0 (vbLeftJustify), Derecha 1 (vbRightJustify), Centrado 2 (vbCenter)
    '
    Dim sTmp As String
    Dim vDerIzq As Integer
    
    sTmp = Space$(iLen)
    If IsMissing(DerIzq) Then
        vDerIzq = vbLeftJustify
    Else
        vDerIzq = CInt(DerIzq)
    End If
    sCadena = Trim$(sCadena)
    'Si no se va a mostrar todo y
    'la longitud a mostrar es mayor de 5, mostrar 3 puntos al final
    If (Len(sCadena) > iLen) And (iLen > 5) Then
        sCadena = Left$(sCadena, iLen - 3) & "..."
    End If
    If vDerIzq = vbRightJustify Then
        RSet sTmp = sCadena
    ElseIf vDerIzq = vbLeftJustify Then
        LSet sTmp = sCadena
    Else    'Centrado
        sTmp = sCadena
        Do While Len(sTmp) < iLen
            sTmp = " " & sTmp & " "
        Loop
	sTmp = Left$(sTmp, iLen)
    End If
    Rellena = sTmp
End Function

Formatear un número a una longitud dada y cambiar los signos de puntuación al indicado.

Esta función la uso para simular el Format$, realmente la hice cuando trabaja con QuickBasic y no existía esa función, de todas formas esta función siempre devuelve cadenas de la longitud especificada en el segundo parámetro.
Si no quieres que el signo de puntuación sea el punto, cambia la constante cSigno para que tenga el valor adecuado.
Si la longitud especificada es un valor negativo, se mostrará el número con la letra D o H, dependiendo del valor.
(esto es fácil de quitar y yo lo tenía para la aplicación de Contabilidad)
Nota: Sólo funciona con números enteros y realmente es para "separar" los miles.

Function PuntoComa(strAs As String, iLoi As Integer, Optional vRelleno) As String
    '----------------------------------------------
    'Si lo<0 mostrar " D" o " H" después del número    (24/Ene/91)
    'Para Visual Basic Windows          (30/Abr/96)
    '                                   (31/May/96)
    'Si se especifica vRelleno, se rellena con ese
    'caracter el principio de la cadena resultante.
    '----------------------------------------------
    Const cSIGNO = "."
    Dim bDebHab As Boolean
    Dim lngA  As Long
    Dim iSigDH As Integer
    Dim strQ As String
    Dim strB As String
    Dim le As Integer
    Dim j As Integer
    Dim a As Integer
    
    Dim iLo As Integer
    Dim strA As String
    
    If IsNull(strAs) Then
        strA = "0"
    Else
        strA = strAs
    End If
    iLo = iLoi
    
    bDebHab = False
    If iLo < 0 Then
        bDebHab = True
        iLo = iLo * (-1) - 2
    End If
    lngA = Val(strA)
    iSigDH = 0
    If lngA < 0& Then
        iSigDH = -1
    ElseIf lngA > 0& Then
        iSigDH = 1
    End If
    If bDebHab Then lngA = Abs(lngA)
    strQ = Str$(lngA)
    strA = strQ
    If Abs(Val(strQ)) > 999 Then
        strQ = LTrim$(RTrim$(strQ))
        le = Len(strQ)
        strA = ""
        j = 0
        For a = le To 1 Step -1
            strB = Mid$(strQ, a, 1)
            If strB <> " " Then
                strA = strB + strA: j = j + 1
                If j = 3 Then strA = cSIGNO + strA: j = 0
            End If
        Next
        While Left$(strA, 1) = cSIGNO
            strA = Mid$(strA, 2)
        Wend
        While Left$(strA, 2) = "-" + cSIGNO
            strA = Left$(strA, 1) + Mid$(strA, 3)
        Wend
        'Si la longitud es mayor, quitar el cSIGNO de puntuación
        If Len(strA) > iLo Then
            Do
                j = InStr(strA, cSIGNO)
                If j Then
                    strA = Left$(strA, j - 1) + Mid$(strA, j + 1)
                Else
                    Exit Do
                End If
            Loop
        End If
    Else
        strA = strQ
    End If
    If bDebHab Then
        If iSigDH < 0 Then
            strQ = " D"
        ElseIf iSigDH > 0 Then
            strQ = " H"
        Else
            strQ = "  "
        End If
        strA = strA + strQ
        iLo = iLo + 2
    End If
    strQ = Right$(Space$(iLo) + strA, iLo)
    If Not IsMissing(vRelleno) Then
        For a = 1 To Len(strQ)
            If Mid$(strQ, a, 1) = " " Then
                Mid$(strQ, a, 1) = vRelleno
            Else
                Exit For
            End If
        Next
    End If
    PuntoComa = strQ
End Function

Cálculo de la letra del NIF.
Esta función recibirá una cadena con un valor y la devolverá añadiendo al final la letra correspondiente.
Si la cadena recibida tiene signos de puntuación, etc., los quitará, realmente sólo deja los números.
Sé que se puede calcular de otra forma más fácil, pero es la que uso desde hace años, la fecha indicada es de cuando la adapté al Visual Basic.

Private Sub CalculaNIF(strA As String)
    '--------------------------------------------------------
    'Calcular la letra del NIF           (13/Sep/95)
    '--------------------------------------------------------
    Const cCADENA = "TRWAGMYFPDXBNJZSQVHLCKE"
    Const cNUMEROS = "0123456789"
    Dim strT As String, strB As String
    Dim a#, NIF#, b#, c#
    Dim i As Integer
    
    strT = Trim$(strA)
    If Len(strT) = 0 Then Exit Sub
    
    strB = ""
    '---Dejar sólo los números...
    For i = 1 To Len(strA)
        If InStr(cNUMEROS, Mid$(strA, i, 1)) Then
            strB = strB + Mid$(strA, i, 1)
        End If
    Next
    strA = strB
    a# = 0
    NIF# = Val(strA)
    Do
        b# = Int(NIF# / 24)
        c# = NIF# - (24 * b#)
        a# = a# + c#
        NIF# = b#
    Loop While b# <> 0
    b# = Int(a# / 23)
    c# = a# - (23 * b#)
    strA = Trim$(strT) + "-" + Mid$(cCADENA, c# + 1, 1)
End Sub

Cambiar los caracteres extraños por ? (para usar en las consultas a bases de datos con LIKE).

Este procedimiento lo uso para las consultas a las bases de datos. De esta forma 'filtro' los caracteres extraños con el signo de interrogación, siempre que realice la comparación con LIKE, ya que la interrogación sirve para indicarle que es cualquier cosa.

Private Sub ChequearCadena(sCadena As String)
    'Comprobar si hay signos no alfabéticos
    Dim i As Integer
    Dim j As Integer
    Dim sCheq As String
    
    'En sCheq estarán todos los signos que no sean
    'letras y Espacio (32), # (35), *(42), ?(63)
    sCheq = Chr$(33) & Chr$(34)
    For j = 36 To 41
        sCheq = sCheq & Chr$(j)
    Next
    For j = 43 To 62
        sCheq = sCheq & Chr$(j)
    Next
    sCheq = sCheq & Chr$(64)
    For j = 91 To 96
        sCheq = sCheq & Chr$(j)
    Next
    For j = 123 To 159
        sCheq = sCheq & Chr$(j)
    Next
    '160 es un espacio
    For j = 161 To 255
        sCheq = sCheq & Chr$(j)
    Next
    'La mayoría de los caracteres de 192 a 255 son acentuadas
    'y las compara igual que las normales
    'Ahora no, porque hace una comparación binaria.
    For i = 1 To Len(sCadena)
        'Obligar a comparar de forma binaria ----v
        j = InStr(1, sCheq, Mid$(sCadena, i, 1), 0)
        If j Then
            Mid$(sCadena, i, 1) = "?"
        End If
    Next
End Sub

ir al índice principal