Ir ao conteúdo
  • Cadastre-se
WILKER.ADM

Macro vba - erro ao executar macro de limpar celulas

Recommended Posts

Boa noite.

 

Estou com um problema ao executar uma macro de limpar que apresenta o erro "Erro em tempo de Execução 13 - Tipos Incompatíveis" ao ser executada.

Mas encontrei o problema, que é um código executável em VBAProject que altera o tamanho de algumas células obedecendo certo critério. Daí ao apagar tais células emite o erro já mencionado. Portanto, preciso de um código complementar à macro limpar, para ser executada com sucesso. 

 

Segue a macro de limpar: 

 

Sub Limpar()
'
' Limpar Macro
'

    Sheets("Objetivos").Range("B5:M6, B9:M44, B46:M46, Q6:AO17").ClearContents
    Sheets("Jan").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    Sheets("Fev").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Mar").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Abr").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Mai").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Jun").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Jul").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Ago").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Set").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Out").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Nov").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("Dez").Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents
    Range("D6").Select
    
    Sheets("PDD").Range("A3:E69, G3:I69, A80:E113, G80:I113").ClearContents
    Rows("3:69").Select
    Range("A69").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Rows("80:113").Select
    Range("A113").Activate
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A3").Select
    
    Sheets("Ajuizamentos").Range("A6:I300").ClearContents
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
    End With
    ActiveWindow.ScrollRow = 6
    Range("A6").Select
    
    Sheets("Objetivos").Select
    ActiveWindow.SmallScroll Down:=-42
    Range("B5").Select
End Sub

 

 

Segue o código VBAProject:

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Target, Me.[V27:AQ29,V31:AQ31]) Is Nothing Then
       Select Case Target.Value
          Case Is < -99999, 99
             Target.Font.Size = 5
          Case Is > -99999, 99
             Target.Font.Size = 7
          Case Is = 0
             Target.Font.Size = 7
          Case " "
             Target.Font.Size = 7
       End Select
    End If
    Application.EnableEvents = True
 End Sub

 

Editado por DiF
Ao postar um código use sempre o botão CODE <>. As citações é só para textos

Compartilhar este post


Link para o post
Compartilhar em outros sites

@WILKER.ADM bom dia,

 

Experimente esta alteração: 

 


Private Sub Worksheet_Change(ByVal Target As Range)
' Se selecionar + de uma celula e alterar, interrompe a rotina:
    If Target.Count > 1 Then Exit Sub
   
    Application.EnableEvents = False
    
    
    If Not Intersect(Target, Me.[V27:AQ29,V31:AQ31]) Is Nothing Then
       Select Case Target.Value
          Case Is < -99999, 99
             Target.Font.Size = 5
          Case Is > -99999, 99
             Target.Font.Size = 7
          Case Is = 0
             Target.Font.Size = 7
          Case " "
             Target.Font.Size = 7
       End Select
    End If
    Application.EnableEvents = True
 End Sub

 

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Qual erro que apresentou ?

Fica difícil dar um diagnostico somente com imagens.

 

De qq forma tente inserir esta linha de codigo que limpa a formatação da celula A69

 

* Após a linha " Range("A69").Activate "  insira:


 
    Range("A69").Clear

 

Se não resolver, compartilher seu arquivo. Facilita!

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Para apagar várias planilhas ao mesmo tempo e diminuir um pouco seu código você poderia usar algo como:

 

    Sheets(Array("Jan", "Fev", "Mar")).Select
    Range("D6:J29, N6:P29, V6:AQ39, AI1, AO1:AO2").ClearContents

 

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×