Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Macro em apenas uma...
 
Notifications
Clear all

Macro em apenas uma parte da planilha

 
2024 - VBA & Macros
Post Recente por efs2016 8 anos atrás
4 Posts
3 Usuários
0 Reactions
917 Visualizações
RSS
 efs2016
(@efs2016)
Posts: 38
Eminent Member
Topic starter
 

Galera, estou com uma dúvida. Preciso de uma planilha para perícia trabalhista. Consegui um código do colega José Luiz Martins, adaptado pelo Reinaldo. Excelente código, todavia, eu preciso que apenas uma parte da Planilha seja formata conforme o macro do Código. Exemplo: Celulas A1 até a E22 seja formata pelo macro e as demais células da planilha não seja formatada conforme o código.
Segue o código:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim HoraDigitada As String
Dim HoraFormatada As String
Dim Tamanho As String
Dim Retorno
Dim Endereço

If Target.HasFormula Then
       Exit Sub
End If

If IsNumeric(Target.Value) = False Then
       Exit Sub
End If
On Error Resume Next
Application.EnableEvents = False
HoraDigitada = Target.Value

    Select Case Len(HoraDigitada)
        Case 1 To 2 ' ex: 12 = 12:00:00
                    Tamanho = "00:00" & ":" & HoraDigitada
                Case 3 ' ex:, 735 = 00:07:35
                    Tamanho = "00:0" & Left(HoraDigitada, 1) & ":" & Right(HoraDigitada, 2)
                Case 4 ' ex:, 1234 = 12:34
                    Tamanho = "00:" & Left(HoraDigitada, 2) & ":" & Right(HoraDigitada, 2)
                Case 5 ' ex:, 12345 = 1:23:45 e não 12:03:45
                    Tamanho = Left(HoraDigitada, 1) & ":" & _
                        Mid(HoraDigitada, 2, 2) & ":" & Right(HoraDigitada, 2)
                Case 6 ' ex:, 123456 = 12:34:56
                    Tamanho = Left(HoraDigitada, 2) & ":" & _
                        Mid(HoraDigitada, 3, 2) & ":" & Right(HoraDigitada, 2)
                Case Else
                    Err.Raise 0
            End Select

Target = Tamanho
Application.EnableEvents = True
End Sub

Alguém poderia me ajudar??

 
Postado : 20/09/2016 7:26 pm
Trindade
 Trindade
(@trindade)
Posts: 278
Reputable Member
 

Bom dia, efs2016.

Teste o código abaixo se te ajuda

Private Sub Worksheet_Change(ByVal Target As Range)

Dim HoraDigitada As String
Dim HoraFormatada As String
Dim Tamanho As String
Dim Retorno
Dim Endereço

    ' LINHA ACRESCENTADA
    If Intersect(Target, Range("A1:E22")) Is Nothing Then Exit Sub

    If Target.HasFormula Then
        Exit Sub
    End If
    
    If IsNumeric(Target.Value) = False Then
        Exit Sub
    End If
    
    On Error Resume Next
    
    Application.EnableEvents = False
    HoraDigitada = Target.Value
    
    Select Case Len(HoraDigitada)
        Case 1 To 2 ' ex: 12 = 12:00:00
            Tamanho = "00:00" & ":" & HoraDigitada
        Case 3 ' ex:, 735 = 00:07:35
            Tamanho = "00:0" & Left(HoraDigitada, 1) & ":" & Right(HoraDigitada, 2)
        Case 4 ' ex:, 1234 = 12:34
            Tamanho = "00:" & Left(HoraDigitada, 2) & ":" & Right(HoraDigitada, 2)
        Case 5 ' ex:, 12345 = 1:23:45 e não 12:03:45
            Tamanho = Left(HoraDigitada, 1) & ":" & _
            Mid(HoraDigitada, 2, 2) & ":" & Right(HoraDigitada, 2)
        Case 6 ' ex:, 123456 = 12:34:56
            Tamanho = Left(HoraDigitada, 2) & ":" & _
            Mid(HoraDigitada, 3, 2) & ":" & Right(HoraDigitada, 2)
        Case Else
            Err.Raise 0
    End Select

Target = Tamanho
Application.EnableEvents = True

End Sub

Se a resposta foi útil! Clique na mãozinha ao lado do botão Citar.
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde.

 
Postado : 21/09/2016 5:43 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Talvez assim:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim HoraDigitada As String
Dim HoraFormatada As String
Dim Tamanho As String
Dim Retorno
Dim Endereço

If Not Intersect(Target, Range("A1:E22")) Is Nothing Then

    If Target.HasFormula Then
        Exit Sub
    End If

    If IsNumeric(Target.Value) = False Then
        Exit Sub
    End If

    On Error Resume Next
    Application.EnableEvents = False
    HoraDigitada = Target.Value

    Select Case Len(HoraDigitada)
        Case 1 To 2 ' ex: 12 = 12:00:00
            Tamanho = "00:00" & ":" & HoraDigitada
        Case 3 ' ex:, 735 = 00:07:35
            Tamanho = "00:0" & Left(HoraDigitada, 1) & ":" & Right(HoraDigitada, 2)
        Case 4 ' ex:, 1234 = 12:34
            Tamanho = "00:" & Left(HoraDigitada, 2) & ":" & Right(HoraDigitada, 2)
        Case 5 ' ex:, 12345 = 1:23:45 e não 12:03:45
            Tamanho = Left(HoraDigitada, 1) & ":" & _
            Mid(HoraDigitada, 2, 2) & ":" & Right(HoraDigitada, 2)
        Case 6 ' ex:, 123456 = 12:34:56
            Tamanho = Left(HoraDigitada, 2) & ":" & _
            Mid(HoraDigitada, 3, 2) & ":" & Right(HoraDigitada, 2)
        Case Else
            Err.Raise 0
    End Select

    Target = Tamanho
    Application.EnableEvents = True
End If
End Sub

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 21/09/2016 5:49 am
 efs2016
(@efs2016)
Posts: 38
Eminent Member
Topic starter
 

Trindade e Reinaldo, muito obrigado!
Eu sou bem leigo com Macros. Ambas serviram e as utilizei, numa planilha pessoal e a outra do trabalho. Do jeito que eu precisava...
Parabéns!!!!

 
Postado : 21/09/2016 5:26 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico