Inquiridor
Execução de Macro com Erro em Tempo de Execução "1004", Excel do Office 365 versão atual
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:
- Erro em tempo de execução "1004" o método Copy da Classe Arc falhou
- 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
