Formatar Cpf

Function FormataCPF(str_cpf As String) As String

On Error Goto erro

Dim cpf_original,CPF,Novostr_cpf,Tam,char,x As String
Dim i As Integer

'seta com o valor recebido como parametro
cpf_original = str_cpf

x = str_cpf
Tam = Len( x )

' se o campo for vazio sai do campo....
If Tam = 0 Then
FormataCPF = cpf_original
Exit Function
End If



Redim PosCaracter( Tam ) As String

For i = 1 To Tam
PosCaracter( i ) = Mid ( x , i , 1)
If Isnumeric ( PosCaracter( i ) ) Then
Novostr_cpf = Novostr_cpf & PosCaracter ( i )
End If
Next i

Tam = Len ( Novostr_cpf )
str_cpf= Novostr_cpf


Char = Cstr(Mid(str_cpf,9,1))


If Char = " " Or str_cpf = " " Then
FormataCPF = cpf_original
Exit Function
End If

Char = Cstr(Mid(str_cpf,11,1))

If Char = " " Then
Char = Cstr(Mid(str_cpf,10,1))
If Char = " " Then
str_cpf = "00" & Mid(str_cpf,1,1) & "." & Mid(str_cpf,2,3) & "." & Mid(str_cpf,5,3)_
& "-" & Mid(str_cpf,8,2)
Else
str_cpf = "0" & Mid(str_cpf,1,2) & "." & Mid(str_cpf,3,3) & "." & Mid(str_cpf,6,3)_
& "-" & Mid(str_cpf,9,2)
End If
Else
str_cpf = Mid(str_cpf,1,3) & "." & Mid(str_cpf,4,3) & "." & Mid( str_cpf ,7,3)_
& "-" & Mid( str_cpf ,10,2)
End If

CPF = str_cpf

If Tam = 11 Then
FormataCPF = str_cpf
Else
FormataCPF = cpf_original
Exit Function
End If


sai:
Exit Function
erro:
Msgbox "Erro na função FormataCPF da biblioteca BibRetencaoImposto na linha " + Str$(Erl) + " do tipo " + Str$(Err) + ": " + Error$
FormataCPF = cpf_original
Resume sai

End Function