[Resolvido]Sobre a Função "TiraAcentos" do JPaulo

Boa noite.

No meu campo "NomePaciente" coloquei o código abaixo para converter todas as palavras para MAIUSCULAS, e funcionou legal.

Private Sub NomePaciente_AfterUpdate()
Dim strCaractere As String
strCaractere = Chr(KeyAscii) ' Converte valor ANSI em seqüência de caracteres.
KeyAscii = Asc(UCase(strCaractere)) ' Converte caractere para maiúsculo e, depois, em valor ANSI.
End Sub

Porém eu quero melhorar e retirar os acentos e cedilhas das palavras e por isso chamei a Função criada pelo JPaulo "DLTiraAcento", ela faz isso mas converte as letras para minúsculas, exceto as primeiras letras de cada palavra.

Gostaria que a função retirasse os acentos e mantivesse as letras em MAIÚSCULO... O que devo modificar nela?
Alguém tem outro código, ou função, que faça isso?

Obrigado.

Abaixo a Função do JPaulo.

Public Function DLTiraAcentos(ByVal strOriginal As String)
'By JPaulo @ 2009
Dim strToReturn As String
strToReturn = ""

Dim I As Integer
For I = 1 To Len(strOriginal)
strToReturn = strToReturn & DLTiraAcentos_GetCorrectChar(Mid$(strOriginal, I, 1))
Next I

DLTiraAcentos = StrConv(strToReturn, 3)

End Function
Public Function DLTiraAcentos_GetCorrectChar(ByVal strChar As String) As String
Dim LetrasComAcentos As String
Dim LetrasSemAcentos As String
LetrasComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"
LetrasSemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"
Dim I As Integer
For I = 1 To Len(LetrasComAcentos)
If strChar = Mid$(LetrasComAcentos, I, 1) Then
DLTiraAcentos_GetCorrectChar = Mid$(LetrasSemAcentos, I, 1)
Exit Function
End If
Next

DLTiraAcentos_GetCorrectChar = strChar
End Function

Olá.

Achei a resposta no próprio forum...

Basta substituir UM NÚMERO em uma das linhas...

Veja o Código como fica:

'-------------------------------------------------------------
Public Function DLTiraAcentos(ByVal strOriginal As String)
'By JPaulo @ 2009
Dim strToReturn As String
strToReturn = ""

Dim I As Integer
For I = 1 To Len(strOriginal)
strToReturn = strToReturn & DLTiraAcentos_GetCorrectChar(Mid$(strOriginal, I, 1))
Next I

' Substituir essa linha abaixo, pela de baixo, em vermelho:

'DLTiraAcentos = StrConv(strToReturn, 3) ' O número 3 faz com quê as primeiras letras de cada palavra fiquem em Maiúsculo e as demais fiquem em minúsculo.
DLTiraAcentos = StrConv(strToReturn, 1) ' O número 1 faz tudo ficar MAIÚSCULO, do jeito que eu quero.
'DLTiraAcentos = StrConv(strToReturn, 2) ' Essa, com o número 2, faz TUDO ficar em minúsculo.


End Function
Public Function DLTiraAcentos_GetCorrectChar(ByVal strChar As String) As String
Dim LetrasComAcentos As String
Dim LetrasSemAcentos As String
LetrasComAcentos = "ÁÍÓÚÉÄÏÖÜËÀÌÒÙÈÃÕÂÎÔÛÊáíóúéäïöüëàìòùèãõâîôûêÇç"
LetrasSemAcentos = "AIOUEAIOUEAIOUEAOAIOUEaioueaioueaioueaoaioueCc"
Dim I As Integer
For I = 1 To Len(LetrasComAcentos)
If strChar = Mid$(LetrasComAcentos, I, 1) Then
DLTiraAcentos_GetCorrectChar = Mid$(LetrasSemAcentos, I, 1)
Exit Function
End If
Next

DLTiraAcentos_GetCorrectChar = strChar
End Function