ERRO NA FUNCAO FORMATMONEYPRESS
Em meu sistema utilizo esta função, mas descobri um erro e não consiguo resolver.E o seguinte:
Por exemplo: eu quero digitar um valor = 10,56, mas a função nunca retorna o zero depois do 1, ou seja, fica assim: 1,56.A função retira o '0'.
Public Function FormatMoneyPress(ByVal Espression As String, ByVal KeyAscNumber As Long, Optional ByVal NumDecimal As Integer = 2) As String
Dim symbolDecimal As String
Dim moneyValue As Variant
Dim makeValue As Variant
Dim Verifies As Boolean
Dim PosNumberZero As Integer
Dim i As Integer
If KeyAscNumber = 8 Then
Exit Function
End If
If KeyAscNumber < 48 Or KeyAscNumber > 57 Then
If KeyAscNumber <> 8 Then
KeyAscNumber = 0
Exit Function
End If
End If
If NumDecimal < 0 Then
NumDecimal = 0
End If
If NumDecimal = 0 Then
Espression = Espression & Chr(KeyAscNumber)
FormatMoneyPress = FormatNumber(Espression, NumDecimal)
Exit Function
End If
symbolDecimal = IIf(InStr(Format(1, "#,##0.00"), ".") > 0, ".", ",")
If Espression = "" Then
Espression = "0" & symbolDecimal & String(NumDecimal, "0")
ElseIf Len(Espression) < 3 Then
Espression = "0" & symbolDecimal & String(NumDecimal, "0")
End If
moneyValue = Espression
makeValue = ""
If Len(Espression) = 2 + NumDecimal And Mid(moneyValue, 1, 1) = 0 Then
If Mid(moneyValue, 2 + NumDecimal, 1) = 0 Then
If Chr(KeyAscNumber) = 0 Then
For i = 1 To 9
If InStr(1, moneyValue, i, vbBinaryCompare) > 0 Then
Verifies = True
End If
Next
End If
If Verifies Then
For i = 1 + NumDecimal To Len(moneyValue)
If i = 1 + NumDecimal Then
makeValue = makeValue & Mid(moneyValue, i, 1) & symbolDecimal
Else
makeValue = makeValue & Mid(moneyValue, i, 1)
End If
Next
Else
For i = 1 To Len(moneyValue) - 1
makeValue = makeValue & Mid(moneyValue, i, 1)
Next
'If i = Len(moneyValue) Then makeValue = moneyValue
End If
ElseIf Mid(moneyValue, 1 + NumDecimal, 1) = 0 Then
For i = 1 To Len(moneyValue) - 2
makeValue = makeValue & Mid(moneyValue, i, 1)
Next
makeValue = makeValue & Mid(moneyValue, 2 + NumDecimal, 1)
ElseIf Mid(moneyValue, InStr(1, moneyValue, symbolDecimal) + 1, 1) = 0 Then
For i = 1 To Len(moneyValue)
If Mid(moneyValue, i, 1) = 0 Then
PosNumberZero = i - 3
End If
Next
For i = 1 To (Len(moneyValue) + PosNumberZero) - (NumDecimal)
makeValue = makeValue & Mid(moneyValue, i, 1)
Next
makeValue = makeValue & Mid(moneyValue, (NumDecimal + 2) - ((NumDecimal + 2) - (PosNumberZero + 4)), ((NumDecimal + 2) - (PosNumberZero + 4) + 1))
ElseIf Mid(moneyValue, 1, 1) = 0 Then
'''
FormatMoneyPress = Mid(moneyValue, InStr(1, moneyValue, symbolDecimal) + 1, 1)
FormatMoneyPress = FormatMoneyPress & symbolDecimal
FormatMoneyPress = FormatMoneyPress & Mid(moneyValue, InStr(1, moneyValue, ",") + 2, Len(moneyValue) - 1) & Chr(KeyAscNumber)
Exit Function
End If
Espression = makeValue & Chr(KeyAscNumber)
ElseIf Len(moneyValue) <> 0 Then
For i = 1 To Len(moneyValue)
If Mid(moneyValue, i, 1) <> symbolDecimal Then
If Len(Mid(moneyValue, i, Len(moneyValue))) = NumDecimal Then
makeValue = makeValue & Mid(moneyValue, i, 1) & symbolDecimal
Else
makeValue = makeValue & Mid(moneyValue, i, 1)
End If
End If
Next
Espression = makeValue & Chr(KeyAscNumber)
Else
Espression = Chr(KeyAscNumber)
End If
FormatMoneyPress = FormatNumber(Espression, NumDecimal)
End Function
Por exemplo: eu quero digitar um valor = 10,56, mas a função nunca retorna o zero depois do 1, ou seja, fica assim: 1,56.A função retira o '0'.
Public Function FormatMoneyPress(ByVal Espression As String, ByVal KeyAscNumber As Long, Optional ByVal NumDecimal As Integer = 2) As String
Dim symbolDecimal As String
Dim moneyValue As Variant
Dim makeValue As Variant
Dim Verifies As Boolean
Dim PosNumberZero As Integer
Dim i As Integer
If KeyAscNumber = 8 Then
Exit Function
End If
If KeyAscNumber < 48 Or KeyAscNumber > 57 Then
If KeyAscNumber <> 8 Then
KeyAscNumber = 0
Exit Function
End If
End If
If NumDecimal < 0 Then
NumDecimal = 0
End If
If NumDecimal = 0 Then
Espression = Espression & Chr(KeyAscNumber)
FormatMoneyPress = FormatNumber(Espression, NumDecimal)
Exit Function
End If
symbolDecimal = IIf(InStr(Format(1, "#,##0.00"), ".") > 0, ".", ",")
If Espression = "" Then
Espression = "0" & symbolDecimal & String(NumDecimal, "0")
ElseIf Len(Espression) < 3 Then
Espression = "0" & symbolDecimal & String(NumDecimal, "0")
End If
moneyValue = Espression
makeValue = ""
If Len(Espression) = 2 + NumDecimal And Mid(moneyValue, 1, 1) = 0 Then
If Mid(moneyValue, 2 + NumDecimal, 1) = 0 Then
If Chr(KeyAscNumber) = 0 Then
For i = 1 To 9
If InStr(1, moneyValue, i, vbBinaryCompare) > 0 Then
Verifies = True
End If
Next
End If
If Verifies Then
For i = 1 + NumDecimal To Len(moneyValue)
If i = 1 + NumDecimal Then
makeValue = makeValue & Mid(moneyValue, i, 1) & symbolDecimal
Else
makeValue = makeValue & Mid(moneyValue, i, 1)
End If
Next
Else
For i = 1 To Len(moneyValue) - 1
makeValue = makeValue & Mid(moneyValue, i, 1)
Next
'If i = Len(moneyValue) Then makeValue = moneyValue
End If
ElseIf Mid(moneyValue, 1 + NumDecimal, 1) = 0 Then
For i = 1 To Len(moneyValue) - 2
makeValue = makeValue & Mid(moneyValue, i, 1)
Next
makeValue = makeValue & Mid(moneyValue, 2 + NumDecimal, 1)
ElseIf Mid(moneyValue, InStr(1, moneyValue, symbolDecimal) + 1, 1) = 0 Then
For i = 1 To Len(moneyValue)
If Mid(moneyValue, i, 1) = 0 Then
PosNumberZero = i - 3
End If
Next
For i = 1 To (Len(moneyValue) + PosNumberZero) - (NumDecimal)
makeValue = makeValue & Mid(moneyValue, i, 1)
Next
makeValue = makeValue & Mid(moneyValue, (NumDecimal + 2) - ((NumDecimal + 2) - (PosNumberZero + 4)), ((NumDecimal + 2) - (PosNumberZero + 4) + 1))
ElseIf Mid(moneyValue, 1, 1) = 0 Then
'''
FormatMoneyPress = Mid(moneyValue, InStr(1, moneyValue, symbolDecimal) + 1, 1)
FormatMoneyPress = FormatMoneyPress & symbolDecimal
FormatMoneyPress = FormatMoneyPress & Mid(moneyValue, InStr(1, moneyValue, ",") + 2, Len(moneyValue) - 1) & Chr(KeyAscNumber)
Exit Function
End If
Espression = makeValue & Chr(KeyAscNumber)
ElseIf Len(moneyValue) <> 0 Then
For i = 1 To Len(moneyValue)
If Mid(moneyValue, i, 1) <> symbolDecimal Then
If Len(Mid(moneyValue, i, Len(moneyValue))) = NumDecimal Then
makeValue = makeValue & Mid(moneyValue, i, 1) & symbolDecimal
Else
makeValue = makeValue & Mid(moneyValue, i, 1)
End If
End If
Next
Espression = makeValue & Chr(KeyAscNumber)
Else
Espression = Chr(KeyAscNumber)
End If
FormatMoneyPress = FormatNumber(Espression, NumDecimal)
End Function
Tópico encerrado , respostas não são mais permitidas