Usuário com melhor resposta
Usar este codigo em várias abas

Pergunta
-
Se coloco em uma aba da conflito para colocar em outras.
Como consigo utilizar em várias abas com ranges diferentes
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub End If On Error GoTo ErrHandler: 'Letra Primeira Maiuscula If Not Application.Intersect(Application.Union(Range("d4:d2002"), Range("e4:e2002"), Range("n4:n2002"), Range("u4:u2002")), Target) Is Nothing Then If Not IsNumeric(Target.Value) Then Application.EnableEvents = False Target.Value = TitleCase(Target.text) Application.EnableEvents = True End If End If Application.EnableEvents = True 'Letras Maiusculas If Target.Column = 3 Or Target.Column = 6 Or Target.Column = 9 Then If Not (Target.text = UCase(Target.text)) Then Target = UCase(Target.text) End If End If ErrHandler: Application.EnableEvents = True End Sub Function TitleCase(text As String) As String Dim doc As Object Dim sentence, word, w Dim i As Long, j As Integer Dim arrLowerCaseWords arrLowerCaseWords = Array("a", "as", "ao", "do", "mm", "cm", "da", "das", "de", "do", "dos", "para", "em", "na", "nas", "no", "à", "o", "os", "e", "é", _ "ou", "com", "sem", "desde", "até", "pelo", "por", "não", "como", "um", "uma", "uns", "são", "mas") text = Application.WorksheetFunction.Proper(text) Set doc = CreateObject("Word.Document") doc.Range.text = text For Each sentence In doc.Sentences For i = 2 To sentence.Words.Count If sentence.Words.Item(i - 1) <> """" Then Set w = sentence.Words.Item(i) For Each word In arrLowerCaseWords If LCase(Trim(w)) = word Then w.text = LCase(w.text) End If j = InStr(w.text, "'") If j Then w.text = Left(w.text, j) & LCase(Right(w.text, Len(w.text) - j)) Next End If Next Next TitleCase = doc.Range.text doc.Close False Set doc = Nothing End Function
Respostas
-
Boa noite, desculpa a demora.
Tem algumas formas de fazer, vou dar um exemplo:
Primeiro é preciso substituir o evento, para considerar toda a pasta:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Em seguida definir uma forma de identificar as planilhas, podendo ser "Nome (Name)", "Código (CodeName)", a posição (Index)", o valor em dada célula, etc:
Select Case Sh.Name
Case "Nome1"Em seguida utilize uma variável para o intervalo desejado:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Intervalo As Range If Target.Cells.Count > 1 Then Exit Sub End If On Error GoTo ErrHandler: 'Letra Primeira Maiuscula Select Case Sh.Name Case "Nome1" Set Intervalo = Application.Union(Range("d4:d2002"), Range("e4:e2002"), Range("n4:n2002"), Range("u4:u2002")) Case "Nome2" 'Set Intervalo = Application.Union( Case "Nome3" 'Set Intervalo = Application.Union( Case Else 'Set Intervalo = Application.Union( End Select If Not Application.Intersect(Intervalo, Target) Is Nothing Then
Compreendido?
Filipe Magno
- Marcado como Resposta BárbaraBettanin quarta-feira, 26 de fevereiro de 2020 10:29
Todas as Respostas
-
Olá, tudo bem contigo?
Então, como você quer que sua função seja amplamente usada no seu projeto, crie um módulo e coloque sua função lá, mas fora de uma chamada de evento. Se reparar bem, a sua primeira linha, essa aqui embaixo,
Private Sub Worksheet_Change(ByVal Target As Range)
se trata de um evento. Esse evento é disparado quando um valore de uma célula é alterado (por isso o nome é Worksheet_Change).
Bom, agora você vai criar uma função do evento Worksheet_Change em cada aba e dentro do evento você vai chamar a função que criou e colocou lá no módulo, lembra? E como parâmetro para a função que tá lá no módulo você passa como parâmetro esse Target (que representa a célula que foi modificada).
Não sei se fui muito claro, mas qualquer coisa a gente vai se falando.
Abração!
-
Para disparar por evento em todas as abas do arquivo basta inserir o código em "EstaPasta_de_trabalho". Assim valerá para qualquer aba existente o que seja criada.
Agora, caso queira intervalos distintos, você terá que listar as regras no seu código dependendo de qual aba esta ativa.
Abraço.
Filipe Magno
-
-
Boa noite, desculpa a demora.
Tem algumas formas de fazer, vou dar um exemplo:
Primeiro é preciso substituir o evento, para considerar toda a pasta:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Em seguida definir uma forma de identificar as planilhas, podendo ser "Nome (Name)", "Código (CodeName)", a posição (Index)", o valor em dada célula, etc:
Select Case Sh.Name
Case "Nome1"Em seguida utilize uma variável para o intervalo desejado:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Intervalo As Range If Target.Cells.Count > 1 Then Exit Sub End If On Error GoTo ErrHandler: 'Letra Primeira Maiuscula Select Case Sh.Name Case "Nome1" Set Intervalo = Application.Union(Range("d4:d2002"), Range("e4:e2002"), Range("n4:n2002"), Range("u4:u2002")) Case "Nome2" 'Set Intervalo = Application.Union( Case "Nome3" 'Set Intervalo = Application.Union( Case Else 'Set Intervalo = Application.Union( End Select If Not Application.Intersect(Intervalo, Target) Is Nothing Then
Compreendido?
Filipe Magno
- Marcado como Resposta BárbaraBettanin quarta-feira, 26 de fevereiro de 2020 10:29
-
Oi Felipe!
Muito obrigada por toda ajuda...
Estou com um erro que não consigo solucionar.
Se colocar apenas 1 Case funciona porem se colocar mais de um da o seguinte erro
- Editado BárbaraBettanin quinta-feira, 20 de fevereiro de 2020 11:38
-
-
-
Boa noite.
Agora que vi que você repetiu o "Select". Esse é o motivo do erro. Para apenas um "Select" insira quantos "Case" quiser, como coloquei no meu exemplo.
Se ainda tiver problemas, poste por favor o código que está utilizando que facilita a análise.
Até.
Filipe Magno
-
Oi Felipe!
Deu certo!!! Muito, mas muito obrigada mesmo!!!
Agora vou abusar um pouco.. rs rs
Essa parte do código em letra maiúscula tem como substituir a forma numérica para identificar a coluna por letras e utilizar o mesmo método do Case para aplicar em várias abas?
'Letras Maiusculas If Target.Column = 3 Or Target.Column = 6 Or Target.Column = 9 Then If Not (Target.text = UCase(Target.text)) Then Target = UCase(Target.text) End If End If
- Editado BárbaraBettanin quarta-feira, 26 de fevereiro de 2020 10:34
-
Boa tarde.
Tem algumas formas sim. A mais simples que acho é trocar o número por:
Range("F1").ColumRange("F1").Columnn '6 Range("F1").ColumRange("I1").Columnn '9
Sobre o "Select" não se entendi bem, mas acho que seria algo do tipo:
Select Case Target.Column Case Range("C1").Column, Range("F1").Column, Range("I1").Column '... 'Case ... '... 'Case Else '... End Select
Abraço.
Filipe Magno