none
Execução de Macro com Erro em Tempo de Execução "1004", Excel do Office 365 versão atual RRS feed

  • Pergunta

  • Bom dia Mestres,

    Preciso de ajuda, e desde já agradeço muito a quem puder dispor de seu precioso tempo e avaliar minha dúvida.

    Estou tendo problemas para rodar uma Macro em uma planilha que vinha trabalhando normalmente até dia 09/05/20 no Excel, Office 2019, chegando a travar de vez, necessitando Depurar e dar continuidade com "F5", rodando quadro a quadro, levando mais de uma hora para concluir o processo. Daí foi piorando chegando ao ponto de fechar o arquivo e reiniciando o Excel.

    Tentei de tudo, fiz várias pesquisas e não consegui solucionar. Decidi por formatar o computador, reinstalando o Windows 10, em seguida comprei o Office 365, versão atual, sendo instalado direto do site da Microsoft.

    Para minha surpresa e decepção, o arquivo continuou com a Macro travando na execução, porém terminando o processo com 4 ou 5 cliques em Depurar e Continuar F5, levando o dobro do tempo de quando rodava normalmente.

    Enviei essa planilha para uns colegas que usam Office 2013 e Office 365 versão 2016, nos quais rodou o processo completo bem tranquilo no mesmo tempo que rodava normal em meu PC.

    Enviei para outro colega com Notebook MAC de 6 anos de uso, com Office 365 recente, no qual rodou tranquilamente, levando um pouco mais de tempo devido ao processador i5 4ª geração.

    Qual seria a explicação para esse evento ? mudança de código no VBA dessa versão do Office 2019 e 365 ?, ou conflito com Windows 10, ressaltando que o PC foi formatado e reinstalado Windows 10 com todas as atualizações requeridas no sistema, incluindo também que o novo Office 365 foi instalado e atualizado adequadamente.

    Erros repetidos apresentados durante o processo:

    1. Erro em tempo de execução "1004" o método Copy da Classe Arc falhou
    2. Erro em tempo de execução "1004" o método Paste da classe Worksheet falhou

    Macro VBA da Planilha:

    'Macro Gerar Diagrama de Produção com Shapes
    Public i, j As Integer
    Public Torre, Tipo_Torre, Sheet_Ativa As String
    Public valor, valor1, A_Executar, ESCAVAÇÃO, PREMONTAGEM, concluido, montagem, teste, T_revisao, revisao, grampeacao, comissionada, liberada, impedida, indefinido, EMBARGO, EMBARGO2, ARQUEOLOGIA, TRAVESSIA, AERODROMO, T_Solo, NIVELAMENTO, CONCRETO
    
    Sub Cria_Diagrama()
    
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        
            
        j = 3   'Coluna inicial
        i = 13  'Coluna inicial
        
        Sheet_Ativa = ActiveSheet.Name   'Guarda o nome da Sheet de trabalho
        
    'Defini a cor da Atividade
        A_Executar = Range("A_Executar").Interior.Color
        ESCAVAÇÃO = Range("ESCAVAÇÃO").Interior.Color
        concluido = Range("concluido").Interior.Color
        NIVELAMENTO = Range("NIVELAMENTO").Interior.Color
        CONCRETO = Range("CONCRETO").Interior.Color
        PREMONTAGEM = Range("Pre_Montagem").Interior.Color
                
    
    'Defini a cor da Torre
        ActiveSheet.Shapes.Range(Array("F_Concluida")).Select
        F_Concluida = Selection.Interior.Color
        'ActiveSheet.Shapes.Range(Array("T_Solo")).Select
        'T_Solo = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("T_Montada")).Select
        montagem = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("T_Revisada")).Select
        T_revisao = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("T_Lançada")).Select
        teste = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("T_Grampeada")).Select
        grampeacao = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("Revisada")).Select
        revisao = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("T_Comissionada")).Select
        comissionada = Selection.Interior.Color
        
    'Defini a cor do Embargo / Impedimento
        ActiveSheet.Shapes.Range(Array("LIBERADA")).Select
        liberada = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("fundiário")).Select
        EMBARGO = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("arqueologia")).Select
        ARQUEOLOGIA = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("travessia")).Select
        TRAVESSIA = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("DEFINIÇÃO_PROJETO")).Select
        DEFINIÇÃO_PROJETO = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("EM_NEGOCIAÇÃO")).Select
        EM_NEGOCIAÇÃO = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("Embargo_Acesso")).Select
        EMBARGO_ACESSO = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("Condicionante")).Select
        Condicionante = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("COND_ACESSO")).Select
        COND_ACESSO = Selection.Interior.Color
        ActiveSheet.Shapes.Range(Array("ERRO")).Select
        indefinido = Selection.Interior.Color
        
        
    Loop1:
        For j = j To 59 'Final da coluna
            
            Torre = Cells(i, j).Value
            If Torre = "" Or Torre = 0 Then
                MsgBox "Verificar " & Torre
                Exit Sub
            End If
            Tipo_Torre = Cells(i, j).Offset(1, 0).Value
                 
            
        'Inclui a Implantação de Torre
         If Application.VLookup(Torre, Range("produção"), (Range("Implantacao").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("Piquete")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 39
                Selection.ShapeRange.IncrementLeft 1
                Selection.ShapeRange.Name = "Piquete-" & Cells(i, j).Value
                
          End If
            
        'Inclui a Indicação da Travessia
         If Application.VLookup(Torre, Range("produção"), (Range("Travessia").Column) - 1, FALSO) <> 0 Then
                ActiveSheet.Shapes.Range(Array("_Travessia")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -34
                Selection.ShapeRange.IncrementLeft 49
                Selection.ShapeRange.Name = "_Travessia-" & Cells(i, j).Value
                
          End If
            
            
        'Inclui a Locação de Cavas
         If Application.VLookup(Torre, Range("produção"), (Range("LOC_CAVAS").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("L_CAVAS")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 56
                Selection.ShapeRange.IncrementLeft 1
                Selection.ShapeRange.Name = "L_CAVAS-" & Cells(i, j).Value
                
          End If
        
        'Verifica se é Estaiada e Inclui a Torre
            If Tipo_Torre = "SPCR" Then
                ActiveSheet.Shapes.Range(Array("_Estaiada")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -4
                Selection.ShapeRange.IncrementLeft 11
                Selection.ShapeRange.Name = Cells(i, j).Value
                Atualiza_Diagrama
           
            'Faz a inclusão do Impedimento
            If Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) <> "L" Then
             If Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "I" Then
                ActiveSheet.Shapes.Range(Array("impedimento")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "A" Then
                ActiveSheet.Shapes.Range(Array("arqueologia")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "T" Then
                ActiveSheet.Shapes.Range(Array("travessia")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "F" Then
                ActiveSheet.Shapes.Range(Array("FUNDIÁRIO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "DP" Then
                ActiveSheet.Shapes.Range(Array("DEFINIÇÃO_PROJETO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "N" Then
                ActiveSheet.Shapes.Range(Array("EM_NEGOCIAÇÃO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "EAC" Then
                ActiveSheet.Shapes.Range(Array("Embargo_Acesso")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "ECO" Then
                ActiveSheet.Shapes.Range(Array("Condicionante")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "ECA" Then
                ActiveSheet.Shapes.Range(Array("COND_ACESSO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
             End If
             End If
           
                        
           
         'Inclui a instalação do contrapeso
         If Application.VLookup(Torre, Range("produção"), (Range("CONTRAPESO").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("CONTRA_PESO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -16
                Selection.ShapeRange.IncrementLeft 15
                Selection.ShapeRange.Name = "CONTRA_PESO-" & Cells(i, j).Value
                  
           End If
           
           'Inclui Sondagem
         'If Application.VLookup(Torre, Range("produção"), (Range("Sondagem").Column) - 1, FALSO) > 1 Then
                'ActiveSheet.Shapes.Range(Array("SPT")).Select
                'Selection.Copy
                'Cells(i, j).Offset(-3, 0).Select
                'ActiveSheet.Paste
                'Selection.ShapeRange.IncrementTop 75
                'Selection.ShapeRange.IncrementLeft 15
                'Selection.ShapeRange.Name = "SPT-" & Cells(i, j).Value
           
           'End If
           
         
        'Inclui premontagem e içamento
         If Application.VLookup(Torre, Range("produção"), (Range("TORRE_LANÇAMENTO").Column) - 1, FALSO) = 1 Then
                ActiveSheet.Shapes.Range(Array("EST_LANC")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 76
                Selection.ShapeRange.IncrementLeft 7.36
                Selection.ShapeRange.Name = "EST_LANC-" & Cells(i, j).Value
                 
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_FACÃO").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_FACÃO").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("ESTAIADA_IÇADA")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 76
                Selection.ShapeRange.IncrementLeft -4
                Selection.ShapeRange.Name = "ESTAIADA_IÇADA-" & Cells(i, j).Value
                 
                 
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_GUINDASTE").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_GUINDASTE").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("ESTAIADA_IÇADA")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 76
                Selection.ShapeRange.IncrementLeft -4
                Selection.ShapeRange.Name = "ESTAIADA_IÇADA-" & Cells(i, j).Value
                 
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_MASTRO").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_MASTRO").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("ESTAIADA_IÇADO_MASTRO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 92
                Selection.ShapeRange.IncrementLeft -4
                Selection.ShapeRange.Name = "ESTAIADA_IÇADO_MASTRO-" & Cells(i, j).Value
           
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_PREMONTADA").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_PREMONTADA").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("ESTAIADA_NO_CHÃO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 100
                Selection.ShapeRange.IncrementLeft -1
                Selection.ShapeRange.Name = "ESTAIADA_NO_CHÃO-" & Cells(i, j).Value
                
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("TORRE_PIQUETE").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("TORRE_PIQUETE").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("TRANS_TORRE")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 101
                Selection.ShapeRange.IncrementLeft 6
                Selection.ShapeRange.Name = "TRANS_TORRE-" & Cells(i, j).Value
                
          
          End If
          
    
            
            ElseIf Tipo_Torre = "SPCR" Then
                ActiveSheet.Shapes.Range(Array("_Estaiada")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -4
                Selection.ShapeRange.IncrementLeft 6
                Selection.ShapeRange.Name = Cells(i, j).Value
                Atualiza_Diagrama
                
            'Inclui a instalação do contrapeso
         If Application.VLookup(Torre, Range("produção"), (Range("CONTRAPESO").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("CONTRA_PESO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -16
                Selection.ShapeRange.IncrementLeft 15
                Selection.ShapeRange.Name = "CONTRA_PESO-" & Cells(i, j).Value
             
          End If
          
            'Inclui a Sondagem
         'If Application.VLookup(Torre, Range("produção"), (Range("Sondagem").Column) - 1, FALSO) > 1 Then
                'ActiveSheet.Shapes.Range(Array("SPT")).Select
                'Selection.Copy
                'Cells(i, j).Offset(-3, 0).Select
                'ActiveSheet.Paste
                'Selection.ShapeRange.IncrementTop 75
                'Selection.ShapeRange.IncrementLeft 15
                'Selection.ShapeRange.Name = "SPT-" & Cells(i, j).Value
          
          'End If
          
                
           'Inclui a medição de resistência
            ElseIf Application.VLookup(Torre, Range("produção"), (Range("RESIS").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("MED_RESIS")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -34
                Selection.ShapeRange.IncrementLeft 12
                Selection.ShapeRange.Name = "MED_RESIS-" & Cells(i, j).Value
                           
          End If
          
          
                
           'Inclui a Lançamento Drone
         If Application.VLookup(Torre, Range("produção"), (Range("L_DRONE").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("LAN_DRONE")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 39
                Selection.ShapeRange.IncrementLeft 1
                Selection.ShapeRange.Name = "LAN_DRONE-" & Cells(i, j).Value
                
          End If
        
        'Verifica se é Auto Portante e Inclui a Torre
             If Tipo_Torre = "SPSL" Or Tipo_Torre = "SPSP" Or Tipo_Torre = "SPA60" Or Tipo_Torre = "SPA30" Or Tipo_Torre = "SPA15" Or Tipo_Torre = "SPSM" Or Tipo_Torre = "SPST" Or Tipo_Torre = "SPTRV" Then
                ActiveSheet.Shapes.Range(Array("APort.")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementLeft 10
                Selection.ShapeRange.Name = Cells(i, j).Value
                Atualiza_Diagrama
               
               
             'Faz a inclusão do Impedimento
            If Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) <> "L" Then
             If Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "I" Then
                ActiveSheet.Shapes.Range(Array("impedimento")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "A" Then
                ActiveSheet.Shapes.Range(Array("arqueologia")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "T" Then
                ActiveSheet.Shapes.Range(Array("travessia")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "F" Then
                ActiveSheet.Shapes.Range(Array("FUNDIÁRIO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "DP" Then
                ActiveSheet.Shapes.Range(Array("DEFINIÇÃO_PROJETO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "N" Then
                ActiveSheet.Shapes.Range(Array("EM_NEGOCIAÇÃO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "EAC" Then
                ActiveSheet.Shapes.Range(Array("Embargo_Acesso")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "ECO" Then
                ActiveSheet.Shapes.Range(Array("Condicionante")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
              ElseIf Application.VLookup(Torre, Range("produção"), (Range("IMPEDIMENTO").Column) - 1, FALSO) = "ECA" Then
                ActiveSheet.Shapes.Range(Array("COND_ACESSO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -8.5
                Selection.ShapeRange.IncrementLeft 5
                Selection.ShapeRange.Name = "impedimento-" & Cells(i, j).Value
             End If
             End If
       
       
       
        'Inclui a instalação do contrapeso
         If Application.VLookup(Torre, Range("produção"), (Range("CONTRAPESO").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("CONTRAPESO").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("CONTRA_PESO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -16
                Selection.ShapeRange.IncrementLeft 15
                Selection.ShapeRange.Name = "CONTRA_PESO-" & Cells(i, j).Value
                
          End If
                
          'Inclui a Sondagem
         'If Application.VLookup(Torre, Range("produção"), (Range("Sondagem").Column) - 1, FALSO) > 1 Then
                'ActiveSheet.Shapes.Range(Array("SPT")).Select
                'Selection.Copy
                'Cells(i, j).Offset(-3, 0).Select
                'ActiveSheet.Paste
                'Selection.ShapeRange.IncrementTop 75
                'Selection.ShapeRange.IncrementLeft 15
                'Selection.ShapeRange.Name = "SPT-" & Cells(i, j).Value
          
          'End If
                
                
        'Inclui a medição de resistência
         ElseIf Application.VLookup(Torre, Range("produção"), (Range("RESIS").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("MED_RESIS")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop -34
                Selection.ShapeRange.IncrementLeft 12
                Selection.ShapeRange.Name = "MED_RESIS-" & Cells(i, j).Value
                     
          End If
          
                         
           
          'Inclui premontagem e montagem Auto Portante
         If Application.VLookup(Torre, Range("produção"), (Range("TORRE_LANÇAMENTO").Column) - 1, FALSO) = 2 Then
                ActiveSheet.Shapes.Range(Array("AUT_LANC")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 76
                Selection.ShapeRange.IncrementLeft 15.35
                Selection.ShapeRange.Name = "AUT_LANC-" & Cells(i, j).Value
                
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE_MONTADA").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE_MONTADA").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("AUTOPORTANTE_EM_PÉ")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 76
                Selection.ShapeRange.IncrementLeft 6
                Selection.ShapeRange.Name = "AUTOPORTANTE_EM_PÉ-" & Cells(i, j).Value
                
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE_IÇADA").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE_IÇADA").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("AUTOPORTANTE_EM_PÉ")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 76
                Selection.ShapeRange.IncrementLeft 6
                Selection.ShapeRange.Name = "AUTOPORTANTE_EM_PÉ-" & Cells(i, j).Value
           
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE_PREMONTADA").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("AUTOPORTANTE_PREMONTADA").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("AUTOPORTANTE_NO_CHÃO")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 80
                Selection.ShapeRange.IncrementLeft 8
                Selection.ShapeRange.Name = "AUTOPORTANTE_NO_CHÃO-" & Cells(i, j).Value
                
           ElseIf Application.VLookup(Torre, Range("produção"), (Range("TORRE_PIQUETE").Column) - 1, FALSO) > 1 And Application.VLookup(Torre, Range("produção"), (Range("TORRE_PIQUETE").Column) - 1, FALSO) < 100000 Then
                ActiveSheet.Shapes.Range(Array("TRANS_TORRE")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 101
                Selection.ShapeRange.IncrementLeft 6
                Selection.ShapeRange.Name = "TRANS_TORRE-" & Cells(i, j).Value
          End If
          
              
              
              'Inclui Condutor Lançado e Grampeado
         If Application.VLookup(Torre, Range("produção"), (Range("CONDUTOR_GRAMPEADO").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("CondutorGrampeado")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 26
                Selection.ShapeRange.IncrementLeft 18
                Selection.ShapeRange.Name = "CondutorGrampeado-" & Cells(i, j).Value
         
         ElseIf Application.VLookup(Torre, Range("produção"), (Range("CONDUTOR_LANÇADO").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("CondutorLançado")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 26
                Selection.ShapeRange.IncrementLeft 18
                Selection.ShapeRange.Name = "CondutorLançado-" & Cells(i, j).Value
         End If
         
              'Inclui Pára-Raios Lançado e Grampeado
         If Application.VLookup(Torre, Range("produção"), (Range("PÁRA_RAIOS_1_GRAMPEADO").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("PáraRaios1Grampeado")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 75.5
                Selection.ShapeRange.IncrementLeft 28.5
                Selection.ShapeRange.Name = "PáraRaios1Grampeado-" & Cells(i, j).Value
         
         ElseIf Application.VLookup(Torre, Range("produção"), (Range("PÁRA_RAIOS_1_LANÇADO").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("PáraRaios1Lançado")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 75.5
                Selection.ShapeRange.IncrementLeft 28.5
                Selection.ShapeRange.Name = "PáraRaios1Lançado-" & Cells(i, j).Value
         End If
         
              'Inclui Fibra Óptica Lançado e Grampeado
         If Application.VLookup(Torre, Range("produção"), (Range("PÁRA_RAIOS_2_GRAMPEADO").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("PáraRaios2Grampeado")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 29
                Selection.ShapeRange.IncrementLeft 13.4
                Selection.ShapeRange.Name = "PáraRaios2Grampeado-" & Cells(i, j).Value
         
         ElseIf Application.VLookup(Torre, Range("produção"), (Range("PÁRA_RAIOS_2_LANÇADO").Column) - 1, FALSO) > 1 Then
                ActiveSheet.Shapes.Range(Array("PáraRaios2Lançado")).Select
                Selection.Copy
                Cells(i, j).Offset(-3, 0).Select
                ActiveSheet.Paste
                Selection.ShapeRange.IncrementTop 29
                Selection.ShapeRange.IncrementLeft 13.4
                Selection.ShapeRange.Name = "PáraRaios2Lançado-" & Cells(i, j).Value
         End If
        
         
         'apaga a definição de montagem manual
         If Application.VLookup(Torre, Range("produção"), (Range("TORRE_PIQUETE").Column) - 1, FALSO) > 1 Then
         If Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_PREMONTADA").Column) - 1, FALSO) > 1 Then
                    ActiveSheet.Shapes.Range(Array("TRANS_TORRE-" & Torre)).Delete
          
         ElseIf Application.VLookup(Torre, Range("produção"), (Range("ESTAIADA_PREMONTADA").Column) - 1, FALSO) > 1 Then
              ActiveSheet.Shapes.Range(Array("TRANS_TORRE-" & Torre)).Delete
          End If
          End If
           
         
        
        
       Next j
       
       'Esta função abaixo é para quando terminar o laço For, ai ele analisa e reinicia o laço com os criterios abaixo da Função IF
          
       If Cells(i, j - 1).Value <> 0 And Cells(i + 7, 3).Value <> 0 Then 'Final da tabela
            i = i + 7
            j = 3
            GoTo Loop1
        Exit Sub
        
        End If
        
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        
    End Sub
    Sub Atualiza_Diagrama()
        
    'Verifica o Status da torre
        valor = Application.VLookup(Torre, Range("produção"), (Range("Coluna_Status").Column - 1), FALSO)
        
    
            'Modifica Pé A
            valor = Application.VLookup(Torre, Range("produção"), (Range("PÉ_A").Column) - 1, FALSO)
            Sheets(Sheet_Ativa).Shapes.Range(Array(Torre)).GroupItems(1).Select
            
            FUNDACAO = Application.VLookup(Torre, Range("produção"), (Range("PÉ_A_2").Column) - 1, FALSO)
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = FUNDACAO
            Status
                
            'Modifica Pé B
            valor = Application.VLookup(Torre, Range("produção"), (Range("PÉ_B").Column) - 1, FALSO)
            Sheets(Sheet_Ativa).Shapes.Range(Array(Torre)).GroupItems(2).Select
            
            FUNDACAO = Application.VLookup(Torre, Range("produção"), (Range("PÉ_B_2").Column) - 1, FALSO)
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = FUNDACAO
            Status
            
            'Modifica Pé C
            valor = Application.VLookup(Torre, Range("produção"), (Range("PÉ_C").Column) - 1, FALSO)
            Sheets(Sheet_Ativa).Shapes.Range(Array(Torre)).GroupItems(4).Select
            
            FUNDACAO = Application.VLookup(Torre, Range("produção"), (Range("PÉ_C_2").Column) - 1, FALSO)
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = FUNDACAO
            Status
            
            'Modifica Pé D
            valor = Application.VLookup(Torre, Range("produção"), (Range("PÉ_D").Column) - 1, FALSO)
            Sheets(Sheet_Ativa).Shapes.Range(Array(Torre)).GroupItems(3).Select
            
            FUNDACAO = Application.VLookup(Torre, Range("produção"), (Range("PÉ_D_2").Column) - 1, FALSO)
            Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = FUNDACAO
            Status
            
            If Tipo_Torre = "SPCR" Then
            
                'Modifica "Mastro Central MF"
                valor = Application.VLookup(Torre, Range("produção"), (Range("MF").Column) - 1, FALSO)
                Sheets(Sheet_Ativa).Shapes.Range(Array(Torre)).GroupItems(5).Select
                
                FUNDACAO = Application.VLookup(Torre, Range("produção"), (Range("MC_2").Column) - 1, FALSO)
                Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = FUNDACAO
                Status
         
         
                'Modifica "Mastro Central ME"
                valor = Application.VLookup(Torre, Range("produção"), (Range("ME").Column) - 1, FALSO)
                Sheets(Sheet_Ativa).Shapes.Range(Array(Torre)).GroupItems(6).Select
                
                FUNDACAO = Application.VLookup(Torre, Range("produção"), (Range("MC_3").Column) - 1, FALSO)
                Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = FUNDACAO
                Status
         
         
            End If
        
         'FAZ A INCLUSÃO DA PRÉ MONTAGEM
         'valor = Application.VLookup(Torre, Range("produção"), (Range("Status_Montagem").Column - 1), FALSO)
         'If valor = "T_Solo" Then
           'Range("Pre_Montagem").Select
           'Selection.Copy
           'Cells(i, j).Offset(-1, 0).Select
           'ActiveSheet.Paste
         'End If
              
              'FAZ A INCLUSÃO DO ACESSO CONCLUIDO
         valor = Application.VLookup(Torre, Range("produção"), (Range("acesso").Column - 1), FALSO)
         If valor > 1 Then
           Cells(i, j).Activate
           ActiveCell.Interior.ColorIndex = 45
         End If
                 
                 'FAZ A INCLUSÃO DA SUPRESSÃO CONCLUIDO
         valor = Application.VLookup(Torre, Range("produção"), (Range("SUPRESSAO_AT").Column - 1), FALSO)
         If valor > 1 Then
           Cells(i, j).Offset(1, 0).Activate
           ActiveCell.Interior.ColorIndex = 43
         End If
                   'FAZ A INCLUSÃO DO CORTE SELETIVO CONCLUIDO
         valor = Application.VLookup(Torre, Range("produção"), (Range("CORTE_SELETIVO").Column - 1), FALSO)
         If valor > 1 Then
           Cells(i, j).Offset(1, 0).Activate
           ActiveCell.Interior.ColorIndex = 10
         End If
         
         
         'Verifica o Status da Torre
            valor = Application.VLookup(Torre, Range("produção"), (Range("Coluna_Status").Column - 1), FALSO)
            If valor = "Comissionada" Or valor = "Revisada" Or valor = "Grampeada" Or valor = "Lançada" _
                Or valor = "T_Revisada" Or valor = "Montada" Or valor = "T_Solo" Or valor = "F_Concluida" Then
                Sheets(Sheet_Ativa).Shapes.Range(Array(Torre)).Select
                Status
                Exit Sub
            End If
            
      
        
    End Sub
    
    Sub Status()
    
    'Defini cor do Status do Pé/Estai
        Select Case valor
        
        Case "A_Executar"
           With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = A_Executar
                .Transparency = 0
                .Solid
            End With
        Case "ESCAVAÇÃO"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = ESCAVAÇÃO
                .Transparency = 0
                .Solid
            End With
        Case "NIVELAMENTO"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = NIVELAMENTO
                .Transparency = 0
                .Solid
            End With
         Case "CONCRETO"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = CONCRETO
                .Transparency = 0
                .Solid
            End With
            
    'Defini cor do Status da Torre
        Case "F_Concluida"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = concluido
                .Transparency = 0
                .Solid
            End With
        Case "T_Revisada"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = T_revisao
                .Transparency = 0
                .Solid
            End With
        Case "Revisada"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = revisao
                .Transparency = 0
                .Solid
            End With
        'Case "T_Solo"
            'With Selection.ShapeRange.Fill
                '.Visible = msoTrue
                '.ForeColor.RGB = T_Solo
                '.Transparency = 0
                '.Solid
            'End With
        Case "Montada"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = montagem
                .Transparency = 0
                .Solid
            End With
        Case "Lançada"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = teste
                .Transparency = 0
                .Solid
            End With
        Case "Grampeada"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = grampeacao
                .Transparency = 0
                .Solid
            End With
        Case "Comissionada"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = comissionada
                .Transparency = 0
                .Solid
            End With
       
    'Defini cor do Embargo / impedimento
       Case "E"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = EMBARGO
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
        Case "L"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = liberada
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoSendToBack
        Case "EI"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = EMBARGO2
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
        Case "A"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = ARQUEOLOGIA
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
        Case "T"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = TRAVESSIA
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
       Case "DP"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = DEFINIÇÃO_PROJETO
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
        Case "N"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = EM_NEGOCIAÇÃO
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
        Case "EAC"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = EMBARGO_ACESSO
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
        Case "ECO"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = Condicionante
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
        Case "ECA"
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = COND_ACESSO
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoBringToFront
    
        Case Is > 1000
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = concluido
                .Transparency = 0
                .Solid
            End With
    
            
        Case FALSO
            With Selection.ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = indefinido
                .Transparency = 0
                .Solid
            End With
            Selection.ShapeRange.ZOrder msoSendToBack
        End Select
    
    
    End Sub
    
    
    terça-feira, 19 de maio de 2020 09:56