Usar este codigo em várias abas

Question

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

Answer 1

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!

Answer 2

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

Answer 3

E como faço para criar a regra no código?

Você conseguiria me ajudar?

Answer 4

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

Answer 5

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

Answer 6

Bom dia.

Pela sua imagem me parece que você não inseriu o restante do seu código. Eu coloquei apenas a parte que alterei. Todo o resto continua da forma que você inseriu no post original.

Seria isso?

---

Filipe Magno

Answer 7

Tentei colocar a sequencia também, mas da sempre esse erro

Answer 8

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

Answer 9

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

Answer 10

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