Erro de compilação procedimento muito grande (VBA Excel).

Boa tarde pessoal estou com problema em um codigo vba algo poderia me ajudar?

Sub DiagramaProdução1A()

'

' novo diagrama produção

'



On Error GoTo TE



Application.ScreenUpdating = False



    i = 12

    j = 3



    counter1 = 14

    

    

    Do While counter1 <> 0

    

Cells(i, j).Select

While Not Cells(i, j).Text = ""  ' continua enquanto linha não estiver em branco

    

    

    ' Teste de resistividade

            

    If Cells(i + 1, j + 129).Text = "33" Then

        

  ActiveSheet.Shapes.Range(Array("CONTRAPESO&quot).Select

    Selection.Copy

    Cells(i - 2, j + 2).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 10.5750393701

    Selection.ShapeRange.IncrementTop 1.5750393701

    Else

    End If

    

    













    

    If Cells(i, j + 129).Text = "ESTAIADA" Then

    

  

    

    

    

    

    

'revisão

    

            If Cells(i - 2, j + 1).Text = "R" And Cells(i, j + 1).Text = "MBCR" Then

        

  ActiveSheet.Shapes.Range(Array("ObjectT&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

      Selection.ShapeRange.IncrementLeft -1.4750393701



  Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

      Selection.ShapeRange.IncrementTop 1.4750393701



  

    PULAR = OK

    Else

    

        If Cells(i - 2, j + 1).Text = "R" Then

        

  ActiveSheet.Shapes.Range(Array("ObjectT&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft -1.4750393701



  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

      Selection.ShapeRange.IncrementTop 1.4750393701

    

  

    PULAR = OK

    Else

    





'montagem

    

    If Cells(i - 2, j + 1).Text = "M" And Cells(i, j + 1).Text = "MBCR" Then



        

        

  ActiveSheet.Shapes.Range(Array("ObjectTM&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

      Selection.ShapeRange.IncrementLeft -1.4750393701



  Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

      Selection.ShapeRange.IncrementTop 1.4750393701

    

    PULAR = "OK"

    Else

    PULAR = "NOK"

    

    If Cells(i - 2, j + 1).Text = "M" Then



        

        

  ActiveSheet.Shapes.Range(Array("ObjectTM&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

      Selection.ShapeRange.IncrementLeft -1.4750393701



  Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

      Selection.ShapeRange.IncrementTop 1.4750393701

      

    PULAR = "OK"

    Else

    PULAR = "NOK"

    

    

    

    'montagem incompleta

    

    If Cells(i - 2, j + 1).Text = "MI" Then



        

        

  ActiveSheet.Shapes.Range(Array("Object 11&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701



    Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

    PULAR = "OK"

    Else

    PULAR = "NOK"

    

    End If

    End If

    End If

    End If

    End If

    

    

    'EHS

    If j > 3 Then

    

    If Cells(i - 2, j - 3).Text = "G" Then

    

    

    ActiveSheet.Shapes.Range(Array("Freeform 127&quot).Select

    Selection.Copy

    Cells(i - 2, j - 3).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    

  

  

    Else

    End If

    Else

    End If

    

          'EHS vão vante

    If j > 3 Then

    



    If j = 108 Then

    If Cells(i - 2, j + 3) = "" And Cells(i + 2, j - 105).Text = "G" Then

    

    

    

    ActiveSheet.Shapes.Range(Array("Freeform 127&quot).Select

    Selection.Copy

    Cells(i - 2, j - 3).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    

  

  Else

    End If

    Else

    End If

    Else

    End If

    

'lançamento

    

    

If j > 3 Then

If Cells(i - 1, j - 3).Text = "L" Then

        

    ActiveSheet.Shapes.Range(Array("Freeform 128&quot).Select

    Selection.Copy

    Cells(i - 2, j - 3).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    

  



    Else

    End If

    Else

    End If

    

    'lançamento OPGW

    

    

If j > 3 Then

If Cells(i - 1, j - 2).Text = "OPGW-L" Then

        

    ActiveSheet.Shapes.Range(Array("Freeform 190&quot).Select

    Selection.Copy

    Cells(i - 2, j - 3).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    

  



    Else

    End If

    Else

    End If

    

    'F1

    

    

If Cells(i, j + 130).Text = "3" Then

    

  ActiveSheet.Shapes.Range(Array("Imagem 1688&quot).Select

    Selection.Copy

    Cells(i, j).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

    Else

    End If

  

      'F2

    

    

If Cells(i, j + 130).Text = "4" Then

    

  ActiveSheet.Shapes.Range(Array("Imagem 1689&quot).Select

    Selection.Copy

    Cells(i, j).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

          Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

    Else

    End If

  

  

  

    

    ' pré montagem

    

    

          If Cells(i - 2, j + 1).Text <> "R" And Cells(i - 2, j + 1).Text <> "M" And Cells(i - 2, j + 1).Text <> "MI" Then

    

    If Cells(i, j + 128).Text = "1" Then

    

  ActiveSheet.Shapes.Range(Array("Imagem 730&quot).Select

    Selection.Copy

    Cells(i, j).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Range("Y73&quot.Select

    

    End If

    

    End If

    

    ' pré montagem

    

    

          If Cells(i - 2, j + 1).Text <> "R" And Cells(i - 2, j + 1).Text <> "M" And Cells(i - 2, j + 1).Text <> "MI" Then

    

    If Cells(i, j + 128).Text = "2" Then

    

  ActiveSheet.Shapes.Range(Array("Imagem750&quot).Select

    Selection.Copy

    Cells(i, j).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Range("Y73&quot.Select

    

    End If

    

    End If

        

  If PULAR = "NOK" Then

  

  ActiveSheet.Shapes.Range(Array("Pizza 83&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

        

    ' 1° quadrante

    ' 1° opção

    '

        



  

  If Cells(i - 2, j).Text = "F" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

  

    

    

    If Cells(i - 2, j).Text = "P" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(147, 119, 103)

        .Transparency = 0

        .Solid

    End With

    Else

    

  

  

  If Cells(i - 2, j).Text = "0" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    Else



  

  If Cells(i - 2, j).Text = "MI" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 0)

        .Transparency = 0

        .Solid

    End With

    Else

    

    

    'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    

    

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

        'CONFERÊNCIA

    

    If Cells(i - 2, j).Text = "COF" Then

        

    'edita grafico

With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

  

  End If

    

  

        End If

        End If

        End If

        End If

        End If

    

      

    

    '

    ' Inicio do 2° quadrante

    '

    

    

  

    

    ActiveSheet.Shapes.Range(Array("PIZZA 86&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

    

    j = j + 1



  

    

    If Cells(i - 2, j).Text = "F" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '6² OPÇÃO

    

    

    If Cells(i - 2, j).Text = "P" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(147, 119, 103)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '5² OPÇÃO

    

    

    If Cells(i - 2, j).Text = "0" Then

        

    'edita grafico

    

      With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    Else

    

            'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

  

    

    

    'Conferência

    

    If Cells(i - 2, j).Text = "COF" Then

        

    'edita grafico

With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

  

    End If

        End If

      

    

    

    

    End If

    End If

      End If

    

        

    

    

    

    j = j - 1

    

    

    





    

    ActiveSheet.Shapes.Range(Array("PIZZA 84&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

    



    

    '

    ' Inicio do 3° quadrante

    '

    

      

    

  

    

    

    '5 opção

    

    

    If Cells(i - 1, j).Text = "F" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '6² OPÇÃO

    

    

    If Cells(i - 1, j).Text = "P" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(147, 119, 103)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '7 opção

    

    

    If Cells(i - 1, j).Text = "0" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    Else

    

        'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    

    End If

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

      'Conferência

    

    If Cells(i - 2, j).Text = "COF" Then

        

    'edita grafico

With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

  

    End If

    

      

        End If

      

    

    

    

    

    

    

    End If

      End If

      End If

      

          

          

          

            

            

            



    

    ActiveSheet.Shapes.Range(Array("PIZZA 85&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

  

    

      j = j + 1



    

    '

    ' Inicio do 4° quadrante

    '

    

      

    

  

    '1 opção

    

    

    If Cells(i - 1, j).Text = "F" Then

        

    'edita grafico

    

    

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '2² OPÇÃO

    

    

    If Cells(i - 1, j).Text = "P" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(147, 119, 103)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '3² OPÇÃO

    

    

    If Cells(i - 1, j).Text = "0" Then

        

    'edita grafico

    

    

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With



    

    Else

    

    

        'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

      'Conferência

    

    If Cells(i - 2, j).Text = "COF" Then

        

    'edita grafico

With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    End If

    

  

    

        End If

    

      

    

  

    

  

    End If

      End If

      End If

      

          j = j - 1

      

      'mc1

      

          ActiveSheet.Shapes.Range(Array("Retângulo Arredondado 89&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

    

    Selection.ShapeRange.IncrementLeft 25.272440944

Selection.ShapeRange.IncrementTop 33.036062991

  

    

    

    

    

    

  

If Cells(i - 2, j).Text = "G" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(49, 197, 213)

        .Transparency = 0

        .Solid

    End With

    Else

    

  

    

    ' 2° opção

    

    

    If Cells(i - 2, j).Text = "L" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(81, 88, 213)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '3 opção

    

    

        If Cells(i - 2, j).Text = "R" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(184, 88, 115)

        .Transparency = 0

        .Solid

    End With

    Else

    

'4° OPÇÃO

    

    If Cells(i - 2, j).Text = "M" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(242, 50, 30)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

        If Cells(i - 2, j).Text = "MI" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 0)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

    '6² OPÇÃO

    

    

    If Cells(i + 1, j + 2).Text = "" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    Else

    



    

    ' 5° OPÇÃO

  

  If Cells(i + 1, j + 2).Text = "MC" Then

        

    

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    

    

      

        'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

      'Conferência

    

    If Cells(i - 2, j).Text = "COF" Then

        

    'edita grafico

With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    End If

    End If

    

    

    

    

    

    

  ' 6° OPÇÃO

  

  If Cells(i + 1, j + 2).Text = "0" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    

    



    Else

    

  

  

    

        End If

    

  

    

        

        End If

        End If

        End If

        End If

        End If

        End If

  

                

        

        

        

        

        

    

    

    

'mc2

    

      

ActiveSheet.Shapes.Range(Array("Retângulo Arredondado 88&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

    

    Selection.ShapeRange.IncrementLeft 52.572440944

  Selection.ShapeRange.IncrementTop 33.036062991



    

    

    If Cells(i - 2, j).Text = "G" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(49, 197, 213)

        .Transparency = 0

        .Solid

    End With

    Else

    

    ' 2° opção

    

    

    If Cells(i - 2, j).Text = "L" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(81, 88, 213)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '3 opção

    

    

        If Cells(i - 2, j).Text = "R" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(184, 88, 115)

        .Transparency = 0

        .Solid

    End With

    Else

    

'4° OPÇÃO

    

    If Cells(i - 2, j).Text = "M" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(242, 50, 30)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

        If Cells(i - 2, j).Text = "MI" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 0)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

    '6² OPÇÃO

    

    

    If Cells(i, j + 2).Text = "" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    Else

    



    

    ' 5° OPÇÃO

  

  If Cells(i, j + 2).Text = "MC2" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    

    

    

      

        'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

      'Conferência

    

    If Cells(i - 2, j).Text = "cof" Then

        

    'edita grafico

With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    End If

    End If

    

    ' 6° OPÇÃO

  

  If Cells(i + 1, j + 140).Text = "0" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    

    



    Else

    

  

  

    

        End If

    

  

    

        End If

        End If

        End If

        End If

        End If

        End If

        End If

        End If

        

        

        'Caso a torre já esteja montada

        Else

        End If

        

        ' pendência de projeto

        

        

        If Cells(i + 1, j + 1).Text = "pp" Then

          ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 4&quot).Select

        Selection.Copy

        Cells(i - 2, j).Select

        ActiveSheet.Paste

      Else

        

        

          ' Embargo sítio arqueológico

          

        

        

        If Cells(i + 1, j + 1).Text = "s" Then

        ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 5&quot).Select

        Selection.Copy

      Cells(i - 2, j).Select

        ActiveSheet.Paste

      Else

      

      

        ' Embargo proprietário

        

        

        If Cells(i + 1, j + 1).Text = "p" Then

        ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 9&quot).Select

        Selection.Copy

      Cells(i - 2, j).Select

        ActiveSheet.Paste

        End If

        End If

        End If

              

        

        

        

      

          

    

Else

                                                      ' Caso torre seja autoportante os dados serão implantado em uma forma quadrada











    

'revisão

    

    

        If Cells(i - 2, j + 1).Text = "R" Then

        

  ActiveSheet.Shapes.Range(Array("Object 10&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

    PULAR = OK

    Else

    

'montagem

    

    If Cells(i - 2, j + 1).Text = "M" Then

        

        

  ActiveSheet.Shapes.Range(Array("Object 9&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

    PULAR = "OK"

    Else

    PULAR = "NOK"

    

    'montagem incompleta

    

    If Cells(i - 2, j + 1).Text = "MI" Then

        

        

  ActiveSheet.Shapes.Range(Array("Object 12&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementLeft -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

  Selection.ShapeRange.IncrementTop -1.8750393701

    PULAR = "OK"

    Else

    PULAR = "NOK"

    

    End If

    

    End If

    End If

  

  

          'grampeação

    If j > 3 Then

    

    If Cells(i - 2, j - 3).Text = "G" Then

    

    

    ActiveSheet.Shapes.Range(Array("Freeform 127&quot).Select

    Selection.Copy

    Cells(i - 2, j - 3).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    

  

  

    Else

    End If

    Else

    End If

    

    'EHS vão vante

    If j > 3 Then

    



    If j = 53 Then

    If Cells(i - 2, j + 3) = "" And Cells(i + 2, j - 50).Text = "G" Then

    

    

    ActiveSheet.Shapes.Range(Array("Freeform 127&quot).Select

    Selection.Copy

    Cells(i - 2, j - 3).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    

  

  

    Else

    End If

    Else

    End If

    Else

    End If

    

'lançamento

    

    

If j > 3 Then

If j > 3 And Cells(i - 1, j - 3).Text = "L" Then

        

    ActiveSheet.Shapes.Range(Array("Freeform 128&quot).Select

    Selection.Copy

    Cells(i - 2, j - 3).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    

  



    Else

    End If

    Else

    End If

    

    'lançamento OPGW

    

    

If j > 3 Then

If Cells(i - 1, j - 2).Text = "OPGW-L" Then

        

    ActiveSheet.Shapes.Range(Array("Freeform 190&quot).Select

    Selection.Copy

    Cells(i - 2, j - 3).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementTop 1.8750393701

    Selection.ShapeRange.IncrementLeft -1.8750393701

    

  



    Else

    End If

    Else

    End If

  

'F1

    

    

If Cells(i, j + 130).Text = "3" Then

    

  ActiveSheet.Shapes.Range(Array("Imagem 1688&quot).Select

    Selection.Copy

    Cells(i, j).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

    Else

    End If

  

      'F2

    

    

If Cells(i, j + 130).Text = "4" Then

    

  ActiveSheet.Shapes.Range(Array("Imagem 1689&quot).Select

    Selection.Copy

    Cells(i, j).Select

    ActiveSheet.Paste

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

      Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

        Selection.ShapeRange.IncrementTop 1.0914173228

    Else

    End If

    



' pré montagem

      If Cells(i - 2, j + 1).Text <> "R" And Cells(i - 2, j + 1).Text <> "M" And Cells(i - 2, j + 1).Text <> "MI" Then



    

    If Cells(i, j + 128).Text = "1" Then

    

ActiveSheet.Shapes.Range(Array("Picture 77&quot).Select

    Selection.Copy

    Cells(i, j).Select

  

      ActiveSheet.Paste

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Selection.ShapeRange.IncrementTop 1.0914173228

    Range("Y73&quot.Select

    

    End If

    

    End If

    

If PULAR = "NOK" Then





    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 239&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    DesprotegerPlanilha

    ActiveSheet.Paste

    

      

    ' 1° quadrante

  

    ' 5° OPÇÃO

  

  If Cells(i - 2, j).Text = "F" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '6² OPÇÃO

    

    

    If Cells(i - 2, j).Text = "P" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(147, 119, 103)

        .Transparency = 0

        .Solid

    End With

    Else

    

    

    

    ' 6° OPÇÃO

  

  If Cells(i - 2, j).Text = "0" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    Else

        

    'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

        'Conferência

        

    If Cells(i - 2, j).Text = "COF" Then

        

    'edita grafico

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

    

    End If

    

    

  

    

    

        End If

          

  

    

        End If

        End If

        End If

      

    

    '

    ' Inicio do 2° quadrante

    '

    

    j = j + 1

    

    

    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 240&quot).Select

    Selection.Copy

    Cells(i - 2, j).Select

    ActiveSheet.Paste

    

  



    

    

    '5² OPÇÃO

    

    

    If Cells(i - 2, j).Text = "F" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '6² OPÇÃO

    

    

    If Cells(i - 2, j).Text = "P" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(147, 119, 103)

        .Transparency = 0

        .Solid

    End With

    Else

    

    

    

    '5² OPÇÃO

    

    

    If Cells(i - 2, j).Text = "0" Then

        

    'edita grafico

    

      With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    Else

    

        '6² OPÇÃO

    

    

    If Cells(i - 2, j).Text = "MI" Then

        

    'edita grafico

    

      With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 0)

        .Transparency = 0

        .Solid

    End With

    Else

    

      'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

        'Conferência

    

    If Cells(i - 2, j).Text = "COF" Then

        

    'edita grafico

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    End If

  

    

      

        End If

        End If

        End If

        End If

        End If

    

      

        

    

    

    

    j = j - 1

    

    

    





    

    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 241&quot).Select

    Selection.Copy

    Cells(i - 1, j).Select

    ActiveSheet.Paste

    



    

    '

    ' Inicio do 3° quadrante

    '

    

      

    

  

    

    '5 opção

    

    

    If Cells(i - 1, j).Text = "F" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '6² OPÇÃO

    

    

    If Cells(i - 1, j).Text = "P" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(147, 119, 103)

        .Transparency = 0

        .Solid

    End With

    Else

    

    

    '6 opção

    

    

    If Cells(i - 1, j).Text = "0" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

    Else

    

        '7 opção

    

    

    

        'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

        'Conferência

    

    If Cells(i - 2, j).Text = "COF" Then

        

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    End If

  

    

  

        End If

    

    



    End If

      End If

      End If

      

          

          

          

            

            

            

    j = j + 1

            

    

    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 242&quot).Select

    Selection.Copy

    Cells(i - 1, j).Select

    ActiveSheet.Paste

  

  



    

    '

    ' Inicio do 4° quadrante

    '

    

      

    

    

    

    '5 opção

    

    

    If Cells(i - 1, j).Text = "F" Then

        

    'edita grafico

    

    

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(46, 205, 9)

        .Transparency = 0

        .Solid

    End With

    Else

    

    '6² OPÇÃO

    

    

    If Cells(i - 1, j).Text = "P" Then

        

    'edita grafico

    

    

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(147, 119, 103)

        .Transparency = 0

        .Solid

    End With

    Else

    

    

    If Cells(i - 1, j).Text = "0" Then

        

    'edita grafico

    

    

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(255, 255, 255)

        .Transparency = 0

        .Solid

    End With

        

    Else

        

          'sondagem & topografia

    

    If Cells(i - 2, j).Text = "ST" Then

        

    'edita grafico

    

  

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    Else

    End If

    

    'SONDAGEM

    

    If Cells(i - 2, j).Text = "SO" Then

        

    'edita grafico

    

  With Selection.ShapeRange.Line

        .Visible = msoTrue

        .ForeColor.ObjectThemeColor = msoThemeColorAccent6

        .ForeColor.TintAndShade = 0

        .ForeColor.Brightness = -0.25

        .Transparency = 0

    End With

    With Selection.ShapeRange.Line

        .Visible = msoTrue

        .Weight = 6

    End With

    

    Else

    End If

    

    

    'TOPOGRAFIA

    

    If Cells(i - 2, j).Text = "TO" Then

        

    'edita grafico

  With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(112, 48, 160)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

      'Conferência

    

    If Cells(i - 2, j).Text = "COF" Then

        

    'edita grafico

    With Selection.ShapeRange.Fill

        .Visible = msoTrue

        .ForeColor.RGB = RGB(0, 176, 240)

        .Transparency = 0

        .Solid

    End With

    

    Else

    

  End If

    

    

        End If

      

      

    

  

    End If

      End If

      End If

      j = j - 1

      

      

      

      

      'caso a torre já  estejá montada

      

      Else

      End If

          

Cells(i, j).Select



          

          ' pendência de projeto

        

        

        If Cells(i + 1, j + 1).Text = "pp" Then

          ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 4&quot).Select

        Selection.Copy

        Cells(i - 2, j).Select

        ActiveSheet.Paste

      Else

        

        

          ' Embargo sítio arqueológico

          

        

        

        If Cells(i + 1, j + 1).Text = "s" Then

        ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 5&quot).Select

        Selection.Copy

      Cells(i - 2, j).Select

        ActiveSheet.Paste

      Else

      

      

        ' Embargo proprietário

        

        

        If Cells(i + 1, j + 1).Text = "p" Then

        ActiveSheet.Shapes.Range(Array("Fluxograma: Somador 9&quot).Select

        Selection.Copy

      Cells(i - 2, j).Select

        ActiveSheet.Paste

        End If

        Cells(i + 1, j + 1).Select

        End If

        End If



        

    



  

        

        End If

        

        j = j + 3

        

        Wend

      

                

        i = i + 4

Cells(i, j).Select

j = 3

        

        

        counter1 = counter1 - 1

        Loop

TE:  'Tratar erro

End Sub