none
Erro de Compilação: Nome repetido encontrado: Worksheet_Change RRS feed

  • Pergunta

  • Boa Tarde! Pessoal!

    Como sou iniciante em VBA, gostaria de ajuda de vocês. Queria incluir os dois códigos, mencionados abaixo, dentro de WORKSHEET_CHANGE. É possível???

    Desde já grato pela atenção.

                                                        

    CÓDIGO 1:

    Option Explicit
    Dim MAIUSCULA As Boolean

    Public Sub Worksheet_Change(ByVal Target As Range)

        Dim MaiscStr As String, C1, C2

        Select Case Target.Cells.Count
            Case Is > 1

                For Each C1 In Range(Target.Address)
                    For Each C2 In Range("D1032")
                        If C1.Address = C2.Address Then
                            If MAIUSCULA Then
                                Selection.Delete
                                MAIUSCULA = Not MAIUSCULA
                                Exit Sub
                            End If


                            Exit Sub
                        End If
                    Next C2
                Next C1
                Exit Sub
            Case Else
                If Application.Intersect(Range(Target.Address), _
                    Range("D1032")) Is Nothing Or Target.Value = "" Then Exit Sub
        End Select

        With Target
            If .HasFormula = False Then
                MaiscStr = UCase(.Value)
                Application.EnableEvents = False
                .Value = (MaiscStr)
            End If
        End With
        Application.EnableEvents = True
    End Sub




    CÓDIGO 2:

    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim TimeStr As String

    On Error GoTo EndMacro
    If Application.Intersect(Target, Range("I31,W35,Y23,AA23,AC23,AE23,AG23,AI23,U33,W33,Y33,AA33,AC33,AE33,AG33,AI33,K45:M75,O45:Q75,S45:U75")) Is Nothing Then
    Exit Sub
    End If
    If Target.Cells.Count > 1 Then
    Exit Sub
    End If
    If Target.Value = "" Then
    Exit Sub
    End If

    Application.EnableEvents = False
    With Target
    If .HasFormula = False Then
    Select Case Len(.Value)
    Case 1 ' e.g., 1 = 00:01 AM
    TimeStr = "00:0" & .Value
    Case 2 ' e.g., 12 = 00:12 AM
    TimeStr = "00:" & .Value
    Case 3 ' e.g., 735 = 7:35 AM
    TimeStr = Left(.Value, 1) & ":" & _
    Right(.Value, 2)
    Case 4 ' e.g., 1234 = 12:34
    TimeStr = Left(.Value, 2) & ":" & _
    Right(.Value, 2)
    Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
    TimeStr = Left(.Value, 1) & ":" & _
    Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
    Case 6 ' e.g., 123456 = 12:34:56
    TimeStr = Left(.Value, 2) & ":" & _
    Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
    Case Else
    Err.Raise 0
    End Select
    .Value = TimeValue(TimeStr)
    End If
    End With
    Application.EnableEvents = True
    Exit Sub
    EndMacro:
    Target.Value = "" 'limpa a célula
        Range(Target.Address).Select
        MsgBox "Atenção! A hora digitada não é válida. Entre com a hora sem digitar os '' : '' (Dois Pontos). Exemplo: 11:30, digite 1130.", vbInformation, "Controle Mensal de Registro de Horas"
    Fim:
        Application.EnableEvents = True

    End Sub

    sábado, 3 de janeiro de 2015 16:01

Respostas

  • Retirei as instruções 'Exit Sub' e pus uns Goto:

    Dim MAIUSCULA As Boolean
    
    Public Sub Worksheet_Change(ByVal Target As Range)
      
      Dim MaiscStr As String, C1, C2
      Dim TimeStr As String
      
      Select Case Target.Cells.Count
        Case Is > 1
          
          For Each C1 In Range(Target.Address)
            For Each C2 In Range("D1032")
              If C1.Address = C2.Address Then
                If MAIUSCULA Then
                  Selection.Delete
                  MAIUSCULA = Not MAIUSCULA
                  GoTo linSkip1
                End If
                GoTo linSkip1
              End If
            Next C2
          Next C1
          GoTo linSkip1
        Case Else
          If Application.Intersect(Range(Target.Address), _
            Range("D1032")) Is Nothing Or Target.Value = "" Then GoTo linSkip1
        End Select
        
        With Target
          If .HasFormula = False Then
            MaiscStr = UCase(.Value)
            Application.EnableEvents = False
            .Value = (MaiscStr)
          End If
        End With
        Application.EnableEvents = True
      
    linSkip1:
      
      On Error GoTo EndMacro
      If Application.Intersect(Target, Range("I31,W35,Y23,AA23,AC23,AE23,AG23,AI23,U33,W33,Y33,AA33,AC33,AE33,AG33,AI33,K45:M75,O45:Q75,S45:U75")) Is Nothing Then
        Exit Sub
      End If
      If Target.Cells.Count > 1 Then
        Exit Sub
      End If
      If Target.Value = "" Then
        Exit Sub
      End If
      
      Application.EnableEvents = False
      With Target
        If .HasFormula = False Then
          Select Case Len(.Value)
            Case 1 ' e.g., 1 = 00:01 AM
              TimeStr = "00:0" & .Value
            Case 2 ' e.g., 12 = 00:12 AM
              TimeStr = "00:" & .Value
            Case 3 ' e.g., 735 = 7:35 AM
              TimeStr = Left(.Value, 1) & ":" & _
              Right(.Value, 2)
            Case 4 ' e.g., 1234 = 12:34
              TimeStr = Left(.Value, 2) & ":" & _
              Right(.Value, 2)
            Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
              TimeStr = Left(.Value, 1) & ":" & _
              Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
            Case 6 ' e.g., 123456 = 12:34:56
              TimeStr = Left(.Value, 2) & ":" & _
              Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
            Case Else
              Err.Raise 0
          End Select
          .Value = TimeValue(TimeStr)
        End If
      End With
      Application.EnableEvents = True
      Exit Sub
    EndMacro:
      Target.Value = "" 'limpa a célula
      Range(Target.Address).Select
      MsgBox "Atenção! A hora digitada não é válida. Entre com a hora sem digitar os '' : '' (Dois Pontos). Exemplo: 11:30, digite 1130.", vbInformation, "Controle Mensal de Registro de Horas"
    Fim:
      Application.EnableEvents = True
      
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 8 de janeiro de 2015 23:05
    Moderador

Todas as Respostas

  • Não analisei sua macro, mas você experimentou mesclar os dois códigos?

    Dim MAIUSCULA As Boolean
    
    Public Sub Worksheet_Change(ByVal Target As Range)
      
      Dim MaiscStr As String, C1, C2
      Dim TimeStr As String
      
      Select Case Target.Cells.Count
        Case Is > 1
          
          For Each C1 In Range(Target.Address)
            For Each C2 In Range("D1032")
              If C1.Address = C2.Address Then
                If MAIUSCULA Then
                  Selection.Delete
                  MAIUSCULA = Not MAIUSCULA
                  Exit Sub
                End If
                Exit Sub
              End If
            Next C2
          Next C1
          Exit Sub
        Case Else
          If Application.Intersect(Range(Target.Address), _
            Range("D1032")) Is Nothing Or Target.Value = "" Then Exit Sub
        End Select
        
        With Target
          If .HasFormula = False Then
            MaiscStr = UCase(.Value)
            Application.EnableEvents = False
            .Value = (MaiscStr)
          End If
        End With
        Application.EnableEvents = True
      
      On Error GoTo EndMacro
      If Application.Intersect(Target, Range("I31,W35,Y23,AA23,AC23,AE23,AG23,AI23,U33,W33,Y33,AA33,AC33,AE33,AG33,AI33,K45:M75,O45:Q75,S45:U75")) Is Nothing Then
        Exit Sub
      End If
      If Target.Cells.Count > 1 Then
        Exit Sub
      End If
      If Target.Value = "" Then
        Exit Sub
      End If
      
      Application.EnableEvents = False
      With Target
        If .HasFormula = False Then
          Select Case Len(.Value)
            Case 1 ' e.g., 1 = 00:01 AM
              TimeStr = "00:0" & .Value
            Case 2 ' e.g., 12 = 00:12 AM
              TimeStr = "00:" & .Value
            Case 3 ' e.g., 735 = 7:35 AM
              TimeStr = Left(.Value, 1) & ":" & _
              Right(.Value, 2)
            Case 4 ' e.g., 1234 = 12:34
              TimeStr = Left(.Value, 2) & ":" & _
              Right(.Value, 2)
            Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
              TimeStr = Left(.Value, 1) & ":" & _
              Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
            Case 6 ' e.g., 123456 = 12:34:56
              TimeStr = Left(.Value, 2) & ":" & _
              Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
            Case Else
              Err.Raise 0
          End Select
          .Value = TimeValue(TimeStr)
        End If
      End With
      Application.EnableEvents = True
      Exit Sub
    EndMacro:
      Target.Value = "" 'limpa a célula
      Range(Target.Address).Select
      MsgBox "Atenção! A hora digitada não é válida. Entre com a hora sem digitar os '' : '' (Dois Pontos). Exemplo: 11:30, digite 1130.", vbInformation, "Controle Mensal de Registro de Horas"
    Fim:
      Application.EnableEvents = True
      
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 8 de janeiro de 2015 12:49
    Moderador
  • Felipe! Boa Tarde!

    Muito obrigado pela ajuda.

    A conversão de letras minúsculas para maiúsculas estão funcionando perfeitamente, mas ao digitar as horas sem os dois pontos está apresentando uma formatação inadequada, ou seja, quando digito 730 sem os dois pontos a mesma formata para 17520:00. Tem que ajustar algo no código?

    Mas uma vez, meu muito obrigado.

    Deus lhe pague!!!

      

    quinta-feira, 8 de janeiro de 2015 20:20
  • Retirei as instruções 'Exit Sub' e pus uns Goto:

    Dim MAIUSCULA As Boolean
    
    Public Sub Worksheet_Change(ByVal Target As Range)
      
      Dim MaiscStr As String, C1, C2
      Dim TimeStr As String
      
      Select Case Target.Cells.Count
        Case Is > 1
          
          For Each C1 In Range(Target.Address)
            For Each C2 In Range("D1032")
              If C1.Address = C2.Address Then
                If MAIUSCULA Then
                  Selection.Delete
                  MAIUSCULA = Not MAIUSCULA
                  GoTo linSkip1
                End If
                GoTo linSkip1
              End If
            Next C2
          Next C1
          GoTo linSkip1
        Case Else
          If Application.Intersect(Range(Target.Address), _
            Range("D1032")) Is Nothing Or Target.Value = "" Then GoTo linSkip1
        End Select
        
        With Target
          If .HasFormula = False Then
            MaiscStr = UCase(.Value)
            Application.EnableEvents = False
            .Value = (MaiscStr)
          End If
        End With
        Application.EnableEvents = True
      
    linSkip1:
      
      On Error GoTo EndMacro
      If Application.Intersect(Target, Range("I31,W35,Y23,AA23,AC23,AE23,AG23,AI23,U33,W33,Y33,AA33,AC33,AE33,AG33,AI33,K45:M75,O45:Q75,S45:U75")) Is Nothing Then
        Exit Sub
      End If
      If Target.Cells.Count > 1 Then
        Exit Sub
      End If
      If Target.Value = "" Then
        Exit Sub
      End If
      
      Application.EnableEvents = False
      With Target
        If .HasFormula = False Then
          Select Case Len(.Value)
            Case 1 ' e.g., 1 = 00:01 AM
              TimeStr = "00:0" & .Value
            Case 2 ' e.g., 12 = 00:12 AM
              TimeStr = "00:" & .Value
            Case 3 ' e.g., 735 = 7:35 AM
              TimeStr = Left(.Value, 1) & ":" & _
              Right(.Value, 2)
            Case 4 ' e.g., 1234 = 12:34
              TimeStr = Left(.Value, 2) & ":" & _
              Right(.Value, 2)
            Case 5 ' e.g., 12345 = 1:23:45 NOT 12:03:45
              TimeStr = Left(.Value, 1) & ":" & _
              Mid(.Value, 2, 2) & ":" & Right(.Value, 2)
            Case 6 ' e.g., 123456 = 12:34:56
              TimeStr = Left(.Value, 2) & ":" & _
              Mid(.Value, 3, 2) & ":" & Right(.Value, 2)
            Case Else
              Err.Raise 0
          End Select
          .Value = TimeValue(TimeStr)
        End If
      End With
      Application.EnableEvents = True
      Exit Sub
    EndMacro:
      Target.Value = "" 'limpa a célula
      Range(Target.Address).Select
      MsgBox "Atenção! A hora digitada não é válida. Entre com a hora sem digitar os '' : '' (Dois Pontos). Exemplo: 11:30, digite 1130.", vbInformation, "Controle Mensal de Registro de Horas"
    Fim:
      Application.EnableEvents = True
      
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 8 de janeiro de 2015 23:05
    Moderador
  • Felipe!

    Agora o código está funcionando perfeitamente.

    Muito obrigado pela ajuda.



    quarta-feira, 14 de janeiro de 2015 00:46