none
Usar este codigo em várias abas RRS feed

  • 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
    

    terça-feira, 11 de fevereiro de 2020 11:29

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
    quinta-feira, 20 de fevereiro de 2020 01:33

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!

    quinta-feira, 13 de fevereiro de 2020 15:01
  • 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

    domingo, 16 de fevereiro de 2020 03:06
  • E como faço para criar a regra no código?

    Você conseguiria me ajudar?

    terça-feira, 18 de fevereiro de 2020 10:08
  • 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
    quinta-feira, 20 de fevereiro de 2020 01:33
  • 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


    quinta-feira, 20 de fevereiro de 2020 11:37
  • 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

    quinta-feira, 20 de fevereiro de 2020 11:44
  • Tentei colocar a sequencia também, mas da sempre esse erro
    sexta-feira, 21 de fevereiro de 2020 20:03
  • 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

    sábado, 22 de fevereiro de 2020 01:37
  • 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


    quarta-feira, 26 de fevereiro de 2020 10:32
  • 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

    quarta-feira, 26 de fevereiro de 2020 17:06