martes, 10 de abril de 2018

VBA Access. Módulo para Leer valores de ficheros de configuración.

'Ejemplos der uso:
'Contenido FicheroTxt1:
'CLAVE1=VALOR1;CLAVE2=VALOR2
'ObtenerValorClave(ContenidoFicheroTxt,"CLAVE1","=",";") => VALOR1

'Contenido FicheroTxt2:
'CLAVE1=VALOR1
'CLAVE2=VALOR2
' ObtenerValorClave(ContenidoFicheroTxt,"CLAVE2","=",vbCrLf) => VALOR2

Public Function ObtenerValorClave(ByVal sValores As String, ByVal sClave As String, ByVal sCarIniClave, ByVal sCarFinClave) As String
On Error GoTo error
    Dim PosIni As Integer
    Dim PosFin As Integer
    Dim sValor As String

    PosIni = GetPosValue(UCase(sValores), UCase(sClave), sCarIniClave)
    PosFin = GetPosValue(UCase(sValores), UCase(sClave), sCarFinClave)
    sValor = GetValue(sValores, PosIni, PosFin)
    ObtenerValorClave = sValor

Exit Function
error:
    ObtenerValorClave = ""
    Debug.Print Err.Number & ": " & Err.Description
End Function

Private Function GetPosValue(ByVal sCadena As String, ByVal sClave As String, ByVal sCarFin) As Integer
On Error GoTo error
    GetPosValue = InStr(1, UCase(sCadena), sClave, vbTextCompare)
    GetPosValue = InStr(GetPosValue, UCase(sCadena), sCarFin, vbTextCompare)

Exit Function
error:
    GetPosValue = 0
End Function

Private Function GetValue(ByVal sCadena As String, ByVal PosIni As Integer, ByVal PosFin As Integer) As String
On Error GoTo error
    If PosFin = 0 And PosIni > 0 Then
        PosFin = Len(sCadena) - PosIni
        GetValue = Trim(Mid(sCadena, PosIni + 1, PosIni - PosFin - 1))
    ElseIf PosIni > 0 Then
        GetValue = Trim(Mid(sCadena, PosIni + 1, PosFin - PosIni - 1))
    Else
        GetValue = ""
    End If
Exit Function
error:
    GetValue = ""
    Debug.Print Err.Number & ": " & Err.Description
End Function

VBA Access. Redondeo de números decimales con el método medio redondeo. Alternativa a la función Round (bankers round)

 Private Function Redondeo(ByVal Numero As Variant, ByVal Decimales As Integer) As Double     'Aplica método medio redondeo (half round ...