Primeira letra maiúscula exceto "de", "do", "da", "dos", etc.

[JGMoreira]

Uso um código para colocar a primeira letra dos nomes em maiúscula há bastante tempo, e nunca consegui fazer com que as conjunções "de", "da", "dos", etc., ficassem em minúsculas, e não "Da", "Do", etc. Não sou bom com VBA, tenho bastante dificuldade, e gostaria, se for possível, de ajuda.
O código que uso é o seguinte:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo ErrHandler:
If Target.Column = 2 Then
If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.Value = StrConv(Target.Text, vbProperCase)
Application.EnableEvents = True
End If
End If
If Target.Column = 4 Then
If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.Value = StrConv(Target.Text, vbProperCase)
Application.EnableEvents = True
End If
End If
If Target.Column = 5 Then
If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.Value = StrConv(Target.Text, vbProperCase)
Application.EnableEvents = True
End If
End If
If Target.Column = 6 Then
If Not IsNumeric(Target.Value) Then
Application.EnableEvents = False
Target.Value = StrConv(Target.Text, vbProperCase)
Application.EnableEvents = True
End If
End If

Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
Application.Calculate
End If
End Sub

[Reinaldo]

O exposto no tópico viewtopic.php?t=3469 não atende/auxilia

Ficaria algo +/-

Código: Selecionar todos

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    'On Error GoTo ErrHandler:
    Select Case Target.Column
        Case 2, 4, 5, 6
            If Not IsNumeric(Target.Value) Then
            Application.EnableEvents = False
            Target.Value = TextConverte(Target.Value)
    'Target.Value = StrConv(Target.Text, vbProperCase)
            Application.EnableEvents = True
            End If
    End Select
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = False Then
Application.Calculate
End If
End Sub
Private Function TextConverte(Texto) As String
'by RMARCO
Dim aArray As Variant, stem As Boolean
Dim nText As String, sCon(11) As String
Dim x As Integer, y As Integer
'Determina termos que não são maiuscula
sCon(1) = "o"
sCon(2) = "os"
sCon(3) = "a"
sCon(4) = "as"
sCon(5) = "do"
sCon(6) = "dos"
sCon(7) = "de"
sCon(8) = "da"
sCon(9) = "das"
sCon(10) = "se"
sCon(11) = "e"

nText = ""
aArray = Split(Texto, " ")
    For x = LBound(aArray) To UBound(aArray)
        stem = False
        For y = 1 To 11 'Altere de acordo com a quantidade de excessoes
            If LCase(aArray(x)) = sCon(y) Then stem = True
         Next
            If stem = False Then
                aArray(x) = Application.Proper(aArray(x))
            Else
                aArray(x) = LCase(aArray(x))
            End If
            
            If x = 0 Then
                nText = aArray(x)
            Else
                nText = nText & " " & aArray(x)
            End If
    Next
TextConverte = nText
End Function

[JGMoreira]

Perfeito!!! Funcionou sem qualquer erro! Como eu disse quando postei minha dúvida, não sou bom com VBA, tenho bastante dificuldade. Muito obrigado ao paciente e compreensivo gênio Reinaldo.