Option Compare Database Option Explicit Private Enum codError codErrorNull = 1000 'Cuando la cuenta es Null codErrCta = 1001 'El número de cuenta es incorrecto codErrLongCta = 1002 'La longitud de la cuenta es errónea codErrDC = 1003 'El dígito de control es erróneo End Enum Public Function CompruebaCuentaBancaria(CuentaBancaria As String) As String '----------------------------------------------------------------------------------------------------------------------- ' Fuente : https://access-global.net/tratamiento-de-errores-errores-personalizados '----------------------------------------------------------------------------------------------------------------------- ' Título : CompruebaCuentaBancaria ' Autor original : Luis Viadel ' Creado : marzo 2016 ' Propósito : verificación de cuenta bancaria mediante 4 comprobaciones, que generan 4 errores personalizados, ' utilizando la función 'CVErr' ' Los errores personalizados que se crean siguen la siguiente numeración: ' 1 Es null ' 2 Contiene sólo números ' 3 Longitud incorrecta ' 4 Dígito de control bancario incorrecto ' Argumentos : La sintaxis de la función consta de un único argumento ' Variable Modo Descripción '----------------------------------------------------------------------------------------------------------------------- ' CuentaBancaria Obligatorio Cuenta bancaria que queremos comprobar '----------------------------------------------------------------------------------------------------------------------- ' Retorno : string con la cuenta bancaria bien construída ' Información : https://support.microsoft.com/en-us/office/cverr-function-d7fd1f1c-3388-4c60-903c-e476865aa467 '----------------------------------------------------------------------------------------------------------------------- Dim cuenta As String, Banco As String Dim Sucursal As String, DC As String Dim NumeroCuenta As String, codPais As String Dim i As Integer Dim IBAN As String Dim coderr As Variant 'Primera comprobación: si es nulo If IsNull(CuentaBancaria) Or CuentaBancaria = vbNullString Then coderr = CVErr(codErrorNull) GoTo LinError Exit Function End If 'Elimina todos los espacios para poder comprobar la longitud cuenta = Replace(CuentaBancaria, " ", "") 'Longitud de cuenta 20 caracteres numéricos 'Longitud de IBAN 4 caracteres alfanuméricos 'Segunda comprobación: longitud de cuenta 'comprueba si tiene 24 caracteres, en el caso de tener 20, añade IBAN genérico If Len(cuenta) = 20 Then 'Comprueba que todos los elementos de la cadena son números For i = 1 To Len(cuenta) If Not IsNumeric(Left(cuenta, i)) Then coderr = CVErr(codErrCta) GoTo LinError End If Next i 'Añade un IBAN genérico cuenta = "ES00" & cuenta ElseIf Len(cuenta) <> 24 Then coderr = CVErr(codErrLongCta) GoTo LinError 'Si no tiene 24 caracteres indica un error End If 'La cadena cuenta es de 24 caracteres 'Deconstruye la cuenta bancaria IBAN = Left(cuenta, 4) codPais = Left(cuenta, 2) NumeroCuenta = Right(cuenta, 10) Banco = Right(Left(cuenta, 8), 4) Sucursal = Right(Left(cuenta, 12), 4) DC = Left(Right(cuenta, 12), 2) 'Tercera comprobación: dígito de control If DigitCalculo(Banco, Sucursal, NumeroCuenta) <> DC Then coderr = CVErr(codErrDC) GoTo LinError End If 'Construimos la primera parte correcta del número de cuenta. Es un número de cuenta válido cuenta = Banco & " " & Sucursal & " " & DC & " " & NumeroCuenta 'Cálculo del IBAN, sin tener en cuenta el IBAN recibido TempVars!CalculoIBAN = IBANCalculo(codPais, cuenta) If IBAN <> TempVars!CalculoIBAN Then MsgBox "El IBAN de su cuenta es " & TempVars!CalculoIBAN, vbInformation + vbOKOnly, "Información sobre la cuenta" CompruebaCuentaBancaria = TempVars!CalculoIBAN & " " & Banco & " " & Sucursal & " " & DC & " " & NumeroCuenta TempVars.RemoveAll Exit Function LinError: Select Case coderr Case CVErr(codErrorNull) MsgBox "El código de cuenta está vacío. Debe indicar un número de cuenta válido", vbExclamation + vbOKOnly, "Error en nº de cuenta" Case CVErr(codErrCta) MsgBox "El código de cuenta es incorrecto. Solo puede contener números excepto en el código de país", vbExclamation + vbOKOnly, "Error en nº de cuenta" Case CVErr(codErrLongCta) MsgBox "La longitud de la cuenta es incorrecta", vbExclamation + vbOKOnly, "Error en nº de cuenta" Case CVErr(codErrDC) MsgBox "El dígito de control es incorrecto", vbExclamation + vbOKOnly, "Error en nº de cuenta" End Select End Function Public Function IBANCalculo(pais As String, cuenta As String) As String '----------------------------------------------------------------------------------------------------------------------- ' Fuente : https://access-global.net/tratamiento-de-errores-errores-personalizados '----------------------------------------------------------------------------------------------------------------------- ' Título : CompruebaCuentaBancaria ' Autor original : Desconocido ' Adaptaado por : Luis Viadel ' Fecha : marzo 2016 ' Propósito : cálculo de los dos números del IBAN de cuenta bancaria que acompañan al código de país ' Argumentos : La sintaxis de la función consta de un único argumento ' Variable Modo Descripción '----------------------------------------------------------------------------------------------------------------------- ' pais Obligatorio código de dos letras indicativo del país (España ES) ' cuenta Obligatorio número de cuenta bancaria '----------------------------------------------------------------------------------------------------------------------- ' Retorno : string con el IBAN calculado '----------------------------------------------------------------------------------------------------------------------- Dim letras As String * 26 Dim Dividendo As Integer Dim resto As Integer, i As Integer Dim IBAN As String ' Calcula el valor de las letras, las quita y añade el valor al final letras = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" IBAN = cuenta & CStr(InStr(1, letras, Left(pais, 1)) + 9) & CStr(InStr(1, letras, Right(pais, 1)) + 9) & "00" For i = 1 To Len(IBAN) Dividendo = resto & Mid(IBAN, i, 1) resto = Dividendo Mod 97 Next i IBANCalculo = pais & Format((98 - resto), "00") End Function Function DigitCalculo(ByVal sBank As String, ByVal sSubBank As String, ByVal sAccount As String) As String '----------------------------------------------------------------------------------------------------------------------- ' Fuente : https://access-global.net/tratamiento-de-errores-errores-personalizados '----------------------------------------------------------------------------------------------------------------------- ' Título : DigitCalculo ' Autor original : Desconocido ' Adaptaado por : Luis Viadel ' Fecha : marzo 2016 ' Propósito : cálculo de los dos números del dígito de control de una cuenta bancaria ' Argumentos : La sintaxis de la función consta de un único argumento ' Variable Modo Descripción '----------------------------------------------------------------------------------------------------------------------- ' sBank Obligatorio Código de la entidad bancaria ' sSubBank Obligatorio Código de la sucursal ' sAccount Obligatorio número de cuenta bancaria '----------------------------------------------------------------------------------------------------------------------- ' Retorno : string con la cuenta bancaria bien construída '----------------------------------------------------------------------------------------------------------------------- TempVars!TempDigit = 0 TempVars!TempDigit = TempVars!TempDigit + Mid(sBank, 1, 1) * 4 TempVars!TempDigit = TempVars!TempDigit + Mid(sBank, 2, 1) * 8 TempVars!TempDigit = TempVars!TempDigit + Mid(sBank, 3, 1) * 5 TempVars!TempDigit = TempVars!TempDigit + Mid(sBank, 4, 1) * 10 TempVars!TempDigit = TempVars!TempDigit + Mid(sSubBank, 1, 1) * 9 TempVars!TempDigit = TempVars!TempDigit + Mid(sSubBank, 2, 1) * 7 TempVars!TempDigit = TempVars!TempDigit + Mid(sSubBank, 3, 1) * 3 TempVars!TempDigit = TempVars!TempDigit + Mid(sSubBank, 4, 1) * 6 TempVars!TempDigit = 11 - (TempVars!TempDigit Mod 11) If TempVars!TempDigit = 11 Then DigitCalculo = "0" ElseIf TempVars!TempDigit = 10 Then DigitCalculo = "1" Else DigitCalculo = Format(TempVars!TempDigit, "0") End If TempVars!TempDigit = 0 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 1, 1) * 1 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 2, 1) * 2 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 3, 1) * 4 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 4, 1) * 8 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 5, 1) * 5 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 6, 1) * 10 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 7, 1) * 9 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 8, 1) * 7 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 9, 1) * 3 TempVars!TempDigit = TempVars!TempDigit + Mid(sAccount, 10, 1) * 6 TempVars!TempDigit = 11 - (TempVars!TempDigit Mod 11) If TempVars!TempDigit = 11 Then DigitCalculo = DigitCalculo + "0" ElseIf TempVars!TempDigit = 10 Then DigitCalculo = DigitCalculo + "1" Else DigitCalculo = DigitCalculo + Format(TempVars!TempDigit, "0") End If TempVars.RemoveAll End Function