HOLA!!!
Al fin!
Termine la funcion, estoy feliz con que sea funcional XD no se como me va a ir con la velocidad, seguro es lenta
Private Function uCaseCorrect7913(Txt As String) As String
Dim X As Long
Dim Y As Long
Dim Aux() As String
Dim MED As Long
Dim Ubi() As Long
Dim Susp As Long
Dim SIGNO(2) As String
SIGNO(0) = ".": SIGNO(1) = "?": SIGNO(2) = "!" 'TOMADO DE XXX-ZERO-XXX
Txt = "." & Txt & "a"
ReDim Sus(Int(Len(Txt) / 3))
ReDim Ubi(Len(Txt) + 5)
'".?¡"
For X = 0 To 2
Do
Y = Y + 1
Ubi(Y) = InStr(Ubi(Y - 1) + 1, Txt, SIGNO(X))
Loop While Ubi(Y) <> 0
Next
'COMPROBAR "..."
Do
Susp = InStr(Susp + 1, Txt, "...")
If Susp <> 0 Then
For X = 1 To Y
If Ubi(X) = Susp + 2 Then Ubi(X) = 0
Next
End If
Loop While Susp <> 0
'PONER MAYUSCULAS A LA PUNTUACION
ReDim Preserve Ubi(Y)
For X = 1 To Y
If Ubi(X) > 0 Then
MED = Ubi(X)
Do
MED = MED + 1
Loop While Not (((Asc(Mid$(Txt, MED, 1)) > 64) And Asc(Mid$(Txt, MED, 1)) < 91) Or ((Asc(Mid$(Txt, MED, 1)) > 96) And Asc(Mid$(Txt, MED, 1)) < 123)) And Not (Mid$(Txt, MED, 1) = "," Or Mid$(Txt, MED, 1) = ";" Or Mid$(Txt, MED, 1) = ".")
Mid$(Txt, MED, 1) = UCase$(Mid$(Txt, MED, 1))
End If
Next
'vbNewLine--------vbNewLine
Aux = Split(Txt, vbNewLine)
For X = 0 To UBound(Aux)
MED = 0
If X <> 0 Then
If Right$(Aux(X - 1), 1) = "." Or Right$(Aux(X - 1), 1) = "?" Or Right$(Aux(X - 1), 1) = "!" Then
Do
MED = MED + 1
Loop While Not (((Asc(Mid$(Aux(X), MED, 1)) > 64) And Asc(Mid$(Aux(X), MED, 1)) < 91) Or ((Asc(Mid$(Aux(X), MED, 1)) > 96) And Asc(Mid$(Aux(X), MED, 1)) < 123))
Mid$(Aux(X), MED, 1) = UCase$(Mid$(Aux(X), MED, 1))
End If
End If
Next
For X = 0 To UBound(Aux)
uCaseCorrect7913 = uCaseCorrect7913 & Aux(X) & vbNewLine
Next
uCaseCorrect7913 = Mid$(uCaseCorrect7913, 2, Len(uCaseCorrect7913) - 4)
End Function
GRACIAS POR LEER!!!
Mostrar Mensajes
