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
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Primeira letra maiúscula exceto "de", "do", "da", "dos", etc.
- Reinaldo
- Jedi
- Mensagens: 1537
- Registrado em: Sex Ago 01, 2014 4:09 pm
- Localização: Garça - SP / SCS - SP
Re: Primeira letra maiúscula exceto "de", "do", "da", "dos", etc.
O exposto no tópico viewtopic.php?t=3469 não atende/auxilia
Ficaria algo +/-
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
Re: Primeira letra maiúscula exceto "de", "do", "da", "dos", etc. [RESOLVIDO]
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.