Este fórum está sendo desativado

[SandroLima]

Boa noite, pessoal

Tenho o seguinte código que converte as primeiras letras em maiúsculas da caixa de texto:

Código: Selecionar todos

Private Sub txt_Paciente_Change()
          
     txt_Paciente.Text = StrConv(txt_Paciente.Text, vbProperCase)
         
End Sub

Achei um outro código que coloca em minúscula as palavras "Da, De e Do" que conectam nomes e sobrenomes. Mas não soube adequá-lo apropriadamente ao código. Vejam como ficou:

Código: Selecionar todos

Private Sub txt_Paciente_Change()
    Dim Troca() As String
    Dim e As Variant
    Dim Nome As String
        
    txt_Paciente.Text = StrConv(txt_Paciente.Text, vbProperCase)
    
    Troca = Split("Da; De; Do", ";")
        
    For Each e In Troca
        txt_Paciente.Text = Replace(Nome, Space(1) & e & Space(1), Space(1) & LCase(e) & Space(1))
    Next e
    
End Sub

Podem me ajudar a corrigir?

[SandroLima]

Bom dia....

Alguém poderia ajudar a corrigir?

[osvaldomp]

Segue uma sugestão que utiliza o evento AfterUpdate ao invés do Change que você está utilizando. A diferença é que o evento Change roda o código ao inserir ou ao deletar cada caracter, então se o nome inserido na TextBox tiver 40 caracteres o código será disparado no mínimo 40 vezes. O evento AfterUpdate irá rodar uma única vez após inserir o nome e apertar Enter ou Tab.

Primeiro o código irá transformar em minúsculas todo o texto inserido e depois colocará maiúsculas no início somente das palavras com mais de três letras.
Ex.
digitando ~~~> WAndErkleiSSoM DOs ANJOS de OLivEIrA DA SilVA dO aMaRaL E DaS Neves
primeiro o código tranasforma para ~~~> wanderkleissom dos anjos de oliveira da silva do amaral e das neves
e depois para ~~~> Wanderkleissom dos Anjos de Oliveira da Silva do Amaral e das Neves

Código: Selecionar todos

Private Sub txt_Paciente_AfterUpdate()
 Dim txbox() As String, i As Long, str As String
  txt_Paciente.Text = StrConv(txt_Paciente.Text, vbLowerCase)
  txbox = Split(txt_Paciente.Text, " ")
  For i = 0 To UBound(txbox)
   If Len(txbox(i)) > 3 Then
    str = str & " " & StrConv(txbox(i), vbProperCase)
   Else: str = str & " " & txbox(i)
   End If
  Next
 txt_Paciente.Text = str
End Sub

[SandroLima]

Obrigado , Osvaldomp

O ideal era que ficasse dentro do evento Change mesmo... mas é melhor alternativa que a minha no momento.

Muito obrigado mais uma vez.

[osvaldomp]

O ideal era que ficasse dentro do evento Change mesmo...

No código que eu sugeri substitua AfterUpdate por Change.

O que você quer dizer como "o ideal seria o evento Change" ? Qual seria a razão ?

[SandroLima]

O que você quer dizer como "o ideal seria o evento Change" ? Qual seria a razão ?

Na verdade só por questão de preferência mesmo.

No código que eu sugeri substitua AfterUpdate por Change.

Nesse caso não funcionou.

Apresentou erro de automação.

O objeto chamado foi desconectado de seus clientes

[osvaldomp]

Na verdade só por questão de preferência mesmo.

Testaí ...

Código: Selecionar todos

Private Sub txt_Paciente_Change()
 Static c As Boolean
 Dim txbox() As String, i As Long, x As Long, y As Long
  If c Then c = False: Exit Sub
  c = True
  txt_Paciente.Text = Application.Proper(txt_Paciente.Text): c = False
   If Len(txt_Paciente.Text) - Len(Replace(txt_Paciente.Text, " ", "")) > 1 Then
    txbox = Split(txt_Paciente.Text, " ")
     For i = 0 To UBound(txbox)
      y = x: x = x + Len(txbox(i)) + 1
      If Len(txbox(i)) < 4 And Left(txbox(i), 1) = "D" And Not txbox(i) Like "?." Then
       c = True
       txt_Paciente.Text = Mid(txt_Paciente.Text, 1, y - 1) & Replace(txt_Paciente.Text, txbox(i), StrConv(txbox(i), vbLowerCase), y, 1)
       c = False
      End If
     Next
   End If
End Sub

[SandroLima]

Wowww, Osvaldomp.

Maravilha... ficou muito bom... O código ainda é um pouco complexo para mim mas vou estudá-lo.

Resolveu o problema do "da", "das", "de", "do" e "dos". Muito bom mesmo. Tinha conseguido uma opção em módulos mas que também só funciona no evento AfterUpdate.

Ficou muito bom mesmo.

Só não funciona no caso do "e".

Ele traz , por exemplo:
- Helena da Costa E Silva
- Carlos Carvalho E Sousa

Qual a alteração necessária?

[osvaldomp]

Só não funciona no caso do "e".
Qual a alteração necessária?

Acrescente a parte em vermelho, conforme abaixo.
If Len(txbox(i)) < 4 And Left(txbox(i), 1) = "D" And Not txbox(i) Like "?." Or txbox(i) = "E" Then

Segue abaixo uma alternativa cuja diferença básica em relação ao código anterior é que você pode incluir/excluir na/da matriz as expressões que ficarão em minúsculas no texto da TextBox. Ainda, o código anterior retorna alguns sobrenomes raros em minúsculas tais como "der", "dav", "det", entre outros, e também retorna a abreviatura "Dr." em minúscula, já esse código abaixo retorna tais sobrenomes e a abreviatura citada com primeira maiúscula.

Código: Selecionar todos

Private Sub txt_Paciente_Change()
 Static c As Boolean
 Dim txbox, str, i As Long, txfi As String
  If c Then c = False: Exit Sub
  str = Array("Da", "Das", "De", "Do", "Dos", "E")
  c = True
  txt_Paciente.Text = Application.Proper(txt_Paciente.Text): c = False
   If Len(txt_Paciente.Text) - Len(Replace(txt_Paciente.Text, " ", "")) = 0 Then Exit Sub
    txbox = Split(txt_Paciente.Text, " ")
     For i = 0 To UBound(txbox)
      If Not IsError(Application.Match(txbox(i), str, 0)) Then
       txfi = txfi & " " & StrConv(txbox(i), vbLowerCase)
      Else: txfi = txfi & " " & Application.Proper(txbox(i))
      End If
       c = True
       txt_Paciente.Text = Right(txfi, Len(txfi) - 1)
       c = False
     Next i
End Sub

[SandroLima]

Excelente, Osvaldomp.

Ficou ótimo assim... vou estudar esse também.

Muito bom mesmo.

Muito obrigado.