Jump to content
Milton Cordova

Eliminar macros Vb de un nuevo archivo

Recommended Posts

Saludoa, tengo el excel 2003 se me ha dseconfigurado en alguna parte, el caso es que mediante macros genero desde un archivo otro, copio algunas hojas en valores , pero las macros del archivo original se siguen manteniendo en el nuevo archivo.
esto venia funcinando normalmente pero repentinamente se me presenta este problema, es alguna configuracion del excel.....?

Gracias lor el apoyo

Milton

Share this post


Link to post
Share on other sites

si las macros están en el modulo de "la hoja" ?... (esta copia es normal)

si las macros están en módulos generales ?... cualquier objeto al que estén asignadas las llama desde el libro "original", entonces...

En ‎01‎/‎04‎/‎2016 at 15:49 , Milton Cordova dijo:

...venia funcinando normalmente pero...

transcribe (al menos) "la macro" con la que haces la copia y que "se lleva" (también) otras macros (?)

saludos,

hector.

Share this post


Link to post
Share on other sites

oK la macro es inmensa

Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Const SND_ASYNC = 1
Sub PLIEGOS3()

'
' PLIEGOS3 Macro
' Macro grabada el 28/09/2010 por MILTON
'

'
'Acelarador de macro

    Estado = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
   ' Código -----------------------


Dim myTime As Date

Rem --- Minimizo Excel y solo muestro el formulario ---
Application.WindowState = xlMinimized

PAISAJE.Show vbModeless
myTime = Now + TimeSerial(0, 0, 2)
Rem --- Cada 5 segundos repinto el formulario ---
If Now > myTime Then
PAISAJE.Repaint
myTime = Now + TimeSerial(0, 0, 2)
End If

DoEvents

Rem --- Aquí comienza la macro propiamente dicha ---

'EMPIEZA EL CALCULO DEL ARCHIVO
    
    Sheets(Array("PRESUPUESTOS", "PU Presup", "CRON Fisico", "R-COMP", "Resumen Equipo", "Resumen materiales", "Agregado" _
        )).Copy
    'macro elimina macros vinculos
    Call DeleteAllCode
    Application.ScreenUpdating = False
    
    'Activa nuevamente el fondo PAISAJE
    PAISAJE.Show vbModeless
myTime = Now + TimeSerial(0, 0, 2)
Rem --- Cada 5 segundos repinto el formulario ---
If Now > myTime Then
PAISAJE.Repaint
myTime = Now + TimeSerial(0, 0, 2)
End If
    '------------------
    
    ActiveSheet.Unprotect "MC"
'ELIMINA FILTRO SI HAY
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    ActiveWorkbook.Sheets("PRESUPUESTOS").Tab.ColorIndex = 2
    
    
    ActiveSheet.Shapes.Range(Array("Picture 1", "Line 3", "AutoShape 4", _
        "AutoShape 5" _
    , "Line 6", "Picture 7", "Picture 8", "Picture 9" _
    , "Picture 10")).Select
    
    Selection.Delete
    
     
    
    Cells.Select
    
    Selection.FormatConditions.Delete

    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("A:E").Select
    Selection.UnMerge
    Range("A1").Select
    'HOJA DE PRECIOS UNITARIOS
    Sheets("PU Presup").Select
    ActiveSheet.Unprotect "MC"
'ELIMINA FILTRO SI HAY
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    
    ActiveWorkbook.Sheets("PU Presup").Tab.ColorIndex = 2
    Cells.Select
    Range("B1").Activate
    ActiveSheet.Shapes.Range(Array("AutoShape 1", "AutoShape 2", "AutoShape 3", _
        "AutoShape 4" _
    , "AutoShape 5", "AutoShape 6", "AutoShape 7", "AutoShape 8" _
    , "AutoShape 9", "AutoShape 10", "AutoShape 11", "AutoShape 12" _
    , "AutoShape 13", "AutoShape 14", "AutoShape 15", "AutoShape 16")).Select
    ActiveSheet.Shapes.Range(Array("AutoShape 17", "AutoShape 18", "AutoShape 19", _
        "AutoShape 20" _
    , "AutoShape 21", "AutoShape 22", "AutoShape 23", "AutoShape 24" _
    , "AutoShape 25", "AutoShape 26", "AutoShape 27", "AutoShape 28" _
    , "AutoShape 29", "AutoShape 30", "AutoShape 31", "AutoShape 32")).Select False
    ActiveSheet.Shapes.Range(Array("AutoShape 33", "AutoShape 34", "AutoShape 35", _
        "AutoShape 36" _
    , "AutoShape 37", "AutoShape 38", "AutoShape 39", "AutoShape 40" _
    , "AutoShape 41", "AutoShape 42", "AutoShape 43", "AutoShape 44" _
    , "AutoShape 45", "AutoShape 46", "AutoShape 47", "AutoShape 48")).Select False
    ActiveSheet.Shapes.Range(Array("AutoShape 49", "AutoShape 50", "AutoShape 51", _
        "AutoShape 52" _
    , "AutoShape 53", "AutoShape 54", "AutoShape 55", "AutoShape 56" _
    , "AutoShape 57", "AutoShape 58", "AutoShape 59", "AutoShape 60" _
    , "AutoShape 61", "AutoShape 62", "AutoShape 63", "AutoShape 64")).Select False
    ActiveSheet.Shapes.Range(Array("AutoShape 65", "AutoShape 66", "AutoShape 67", _
        "AutoShape 68" _
    , "AutoShape 69", "AutoShape 70", "AutoShape 71", "AutoShape 72" _
    , "AutoShape 73", "AutoShape 74", "AutoShape 75", "AutoShape 76" _
    , "AutoShape 77", "AutoShape 78", "AutoShape 79", "AutoShape 80")).Select False
    ActiveSheet.Shapes.Range(Array("AutoShape 81", "AutoShape 82", "AutoShape 83", _
        "AutoShape 84" _
    , "AutoShape 85", "AutoShape 86", "AutoShape 87", "AutoShape 88" _
    , "AutoShape 89", "AutoShape 90", "AutoShape 91", "AutoShape 92" _
    , "AutoShape 93", "AutoShape 94", "AutoShape 95", "AutoShape 96")).Select False
    ActiveSheet.Shapes.Range(Array("AutoShape 97", "AutoShape 98", "AutoShape 99", _
        "AutoShape 100" _
    , "AutoShape 101", "AutoShape 102", "AutoShape 103", "AutoShape 104" _
    , "AutoShape 105", "AutoShape 106", "AutoShape 107", "AutoShape 108" _
    , "AutoShape 109", "AutoShape 110", "AutoShape 111", "AutoShape 112")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 113", "AutoShape 114", _
        "AutoShape 115", "AutoShape 116" _
    , "AutoShape 117", "AutoShape 118", "AutoShape 119", "AutoShape 120" _
    , "AutoShape 121", "AutoShape 122", "AutoShape 123", "AutoShape 124" _
    , "AutoShape 125", "AutoShape 126", "AutoShape 127", "AutoShape 128")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 129", "AutoShape 130", _
        "AutoShape 131", "AutoShape 132" _
    , "AutoShape 133", "AutoShape 134", "AutoShape 135", "AutoShape 136" _
    , "AutoShape 137", "AutoShape 138", "AutoShape 139", "AutoShape 140" _
    , "AutoShape 141", "AutoShape 142", "AutoShape 143", "AutoShape 144")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 145", "AutoShape 146", _
        "AutoShape 147", "AutoShape 148" _
    , "AutoShape 149", "AutoShape 150", "AutoShape 151", "AutoShape 152" _
    , "AutoShape 153", "AutoShape 154", "AutoShape 155", "AutoShape 156" _
    , "AutoShape 157", "AutoShape 158", "AutoShape 159", "AutoShape 160")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 161", "AutoShape 162", _
        "AutoShape 163", "AutoShape 164" _
    , "AutoShape 165", "AutoShape 166", "AutoShape 167", "AutoShape 168" _
    , "AutoShape 169", "AutoShape 170", "AutoShape 171", "AutoShape 172" _
    , "AutoShape 173", "AutoShape 174", "AutoShape 175", "AutoShape 176")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 177", "AutoShape 178", _
        "AutoShape 179", "AutoShape 180" _
    , "AutoShape 181", "AutoShape 182", "AutoShape 183", "AutoShape 184" _
    , "AutoShape 185", "AutoShape 186", "AutoShape 187", "AutoShape 188" _
    , "AutoShape 189", "AutoShape 190", "AutoShape 191", "AutoShape 192")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 193", "AutoShape 194", _
        "AutoShape 195", "AutoShape 196" _
    , "AutoShape 197", "AutoShape 198", "AutoShape 199", "AutoShape 200" _
    , "AutoShape 201", "AutoShape 202", "AutoShape 203", "AutoShape 204" _
    , "AutoShape 205", "AutoShape 206", "AutoShape 207", "AutoShape 208")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 209", "AutoShape 210", _
        "AutoShape 211", "AutoShape 212" _
    , "AutoShape 213", "AutoShape 214", "AutoShape 215", "AutoShape 216" _
    , "AutoShape 217", "AutoShape 218", "AutoShape 219", "AutoShape 220" _
    , "AutoShape 221", "AutoShape 222", "AutoShape 223", "AutoShape 224")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 225", "AutoShape 226", _
        "AutoShape 227", "AutoShape 228" _
    , "AutoShape 229", "AutoShape 230", "AutoShape 231", "AutoShape 232" _
    , "AutoShape 233", "AutoShape 234", "AutoShape 235", "AutoShape 236" _
    , "AutoShape 237", "AutoShape 238", "AutoShape 239", "AutoShape 240")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 241", "AutoShape 242", _
        "AutoShape 243", "AutoShape 244" _
    , "AutoShape 245", "AutoShape 246", "AutoShape 247", "AutoShape 248" _
    , "AutoShape 249", "AutoShape 250", "AutoShape 251", "AutoShape 252" _
    , "AutoShape 253", "AutoShape 254", "AutoShape 255", "AutoShape 256")).Select _
        False
    ActiveSheet.Shapes.Range(Array("AutoShape 257", "AutoShape 258", _
        "AutoShape 259", "AutoShape 260" _
    , "AutoShape 261", "AutoShape 262", "AutoShape 263", "AutoShape 264" _
    , "AutoShape 265", "AutoShape 266", "AutoShape 267", "AutoShape 268" _
    , "AutoShape 269", "AutoShape 270", "AutoShape 271", "Picture 272")).Select _
        False
    ActiveSheet.Shapes.Range(Array("Line 273", "Text Box 274", "AutoShape 275", _
        "Picture 276" _
    )).Select False
    Selection.Delete
    Range("D1").Select
    
    Range("A1:C1").Select
    Selection.EntireColumn.Hidden = False
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    
    'CALCULO DE MANO DE OBRA
    Sheets("R-COMP").Select
    ActiveSheet.Unprotect "MC"
    'ELIMINA FILTRO SI HAY
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1").Select
    Sheets("R-COMP").Select
    ActiveWorkbook.Sheets("R-COMP").Tab.ColorIndex = 2
    
    'Resumen de equipo
    Sheets("Resumen Equipo").Select
    ActiveSheet.Unprotect "MC"
    ActiveWorkbook.Sheets("Resumen Equipo").Tab.ColorIndex = 2
    ActiveSheet.Shapes.Range(Array("Picture 1", "Rectangle 2", "Line 3", "Line 4" _
    )).Select
    Selection.Delete
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A12").Select
    
    'CALCULO DE PRESUPUESTOS
    Sheets("PRESUPUESTOS").Select
    Selection.ColumnWidth = 30
    Columns("A:A").Select
    Selection.Clear
    Range("B13:E13").Select
    Selection.EntireColumn.Delete
    Range("J19:AD19").Select
    Selection.EntireColumn.Hidden = False
    Range("H20:O20").Select
    Selection.EntireColumn.Delete
    Range("I20:U20").Select
    Selection.EntireColumn.Delete
    Range("H3").Select
    Selection.AutoFilter
    Range("H3:H293").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>"
    Selection.EntireColumn.Hidden = True
    Columns("B:G").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0
    Selection.ClearComments
    ActiveWindow.SmallScroll Down:=21
    Range("G15").Select
Sheets("PRESUPUESTOS").Select
Sheets("PRESUPUESTOS").Name = "Presupuesto Original"
    
    Range("C288").Select
    ActiveCell.FormulaR1C1 = "FIRMA OFERENTE O REPRESENTANTE LEGAL"
    Range("C289").Select
    Selection.ClearContents
    Range("D289").Select
    ActiveCell.FormulaR1C1 = "LUGAR  Y  FECHA"
    
    'Borra datos columnas de actualizacion 2012
    Columns("I:I").Select
    Selection.Clear
    Range("B2:G2").Select
    
    
   'Continua calculo con hoja PU Presup
    Sheets("PU Presup").Select
    Range("D1:G1").Select
    Selection.Clear
    Range("F1:G1").Select
    Selection.Clear
    Range("B2:G2").Select
    Columns("A:D").Select
    Range("D1").Activate
    Selection.EntireColumn.Hidden = False
    Range("A2").Select
    Selection.ColumnWidth = 30
    Columns("A:A").Select
    Selection.Clear
    Range("B2:C2").Select
    Selection.EntireColumn.Delete
    Range("M1:N1").Select
    Selection.EntireColumn.Delete
    Columns("B:G").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0
    Selection.ClearComments
    Range("H1:I2").Select
    Selection.Clear
    
'TITULO AGREGADO ECUATORIANO
    Range("H2:L2").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.FormulaR1C1 = "VAE VALOR AGREGADO ECUATORIANO"
    Range("H2:L2").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("B2:G2").Select
    '-----------
    
    Range("B2:G2").Select
    
'Calculo de Cronograma valorado
    
    Sheets("CRON Fisico").Select
    ActiveSheet.Unprotect "MC"
    
    
     ActiveSheet.Shapes.Range(Array("Line 4", "Line 5", "Line 6", "AutoShape 7" _
    , "AutoShape 8", "Picture 11", "Line 12", "Picture 13" _
    , "Picture 14", "Picture 15")).Select
    Selection.Delete
    
    
'Elimina valor Cronograma G855
    Range("N855").Select
    Selection.ClearContents
    '-----------

    Range("A1:H1").Select
    Selection.EntireColumn.Hidden = False
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Columns("A:H").Select
    Selection.UnMerge
    Columns("A:A").Select
    Selection.Clear
    Range("B1:H1").Select
    Selection.EntireColumn.Delete
    Rows("1:1").Select
    Selection.Clear
    Range("A2:A5").Select
    Selection.EntireRow.Delete
    Cells.Select
    Selection.Font.ColorIndex = 0
    Selection.Interior.ColorIndex = xlNone
    Range("H7:AQ8").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
    Range("AR1:CJ2").Select
    Range("AR2").Activate
    Selection.EntireColumn.Hidden = False
    Range("AR5:CF5").Select
    Selection.EntireColumn.Delete
    Range("AR5").Select
    Selection.AutoFilter Field:=1, Criteria1:="<>"
    Range("AR5").Select
    Selection.EntireColumn.Hidden = True
    
'Elimina valor Cronograma N55
    Range("G851").Select
    Selection.ClearContents
    '-----------
    Range("C7:C9").Select
    ActiveSheet.Protect "XX"
    ActiveWindow.SmallScroll Down:=-15
    
    Sheets("CRON Fisico").Select
    ActiveWorkbook.Sheets("CRON Fisico").Tab.ColorIndex = 2
    Sheets("CRON Fisico").Select
    Sheets("CRON Fisico").Name = "Cronograma Valorado"
    Range("C7:C9").Select
    
'calculo de Mano de Obra
    Sheets("R-COMP").Select
    Range("B1:H7").Select
    Selection.UnMerge
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Columns("B:H").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0
    Range("B4:H7").Select
    Selection.UnMerge
    Selection.Clear
    Selection.RowHeight = 30
    Range("B4:B7").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B3").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 26
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("J7:L7").Select
    Selection.EntireColumn.Hidden = False
    Range("D11:J13").Select
    Selection.EntireColumn.Delete
    Range("D10").Select
    Selection.Interior.ColorIndex = xlNone
    Range("A10").Select
    ActiveWindow.SmallScroll Down:=21
    Range("A35:A47").Select
    Selection.EntireRow.Delete
    Range("C10:D38").Select
    Selection.ClearContents
    Range("C10:D10").Select
    Selection.ColumnWidth = 22
    Selection.ColumnWidth = 25
    Range("B11:B39").Select
    Selection.ClearContents
    Range("D10:J10").Select
    Selection.EntireColumn.Insert
    Selection.RowHeight = 50
    Range("B10").Select
    ActiveCell.FormulaR1C1 = "NOMBRE"
    Range("C10").Select
    ActiveCell.FormulaR1C1 = "NACIONALIDAD"
    Range("D10").Select
    ActiveCell.FormulaR1C1 = "TITULO"
    Range("E10").Select
    ActiveCell.FormulaR1C1 = "FECHA DE" & Chr(10) & "GRADO"
    With ActiveCell.Characters(Start:=1, Length:=14).Font
        .Name = "Arial"
        .FontStyle = "Negrita"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("F10").Select
    ActiveCell.FormulaR1C1 = "CARGO A" & Chr(10) & "OCUPAR"
    With ActiveCell.Characters(Start:=1, Length:=14).Font
        .Name = "Arial"
        .FontStyle = "Negrita"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("G10").Select
    ActiveCell.FormulaR1C1 = "PARTICIPACION"
    Range("H10").Select
    ActiveCell.FormulaR1C1 = "TIENE" & Chr(10) & "JEFATURA"
    With ActiveCell.Characters(Start:=1, Length:=14).Font
        .Name = "Arial"
        .FontStyle = "Negrita"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("I10").Select
    ActiveCell.FormulaR1C1 = "EXPERIENCIA EN" & Chr(10) & "OTRAS OBRAS"
    With ActiveCell.Characters(Start:=1, Length:=26).Font
        .Name = "Arial"
        .FontStyle = "Negrita"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("J10").Select
    ActiveCell.FormulaR1C1 = "OBSERVACIONES"
    Range("J11").Select
    Columns("I:I").ColumnWidth = 31.71
    Columns("J:J").ColumnWidth = 32.14
    Range("K11").Select
    Selection.EntireColumn.Delete
    Range("B9:J9").Select
    Selection.Merge
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    ActiveCell.FormulaR1C1 = "PERSONAL TECNICO PROPUESTO PARA EL PROYECTO"
    Range("B3:J3").Select
    Selection.Merge
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "Formulario : 8"
    Range("B4:B7").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "NOMBRE DEL OFERENTE :"
    Range("B6").Select
    ActiveCell.FormulaR1C1 = "='Presupuesto original'!R[-2]C:R[-2]C[5]"
    Range("B6").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B10").Select
    ActiveWindow.SmallScroll Down:=13
    Range("B37:B40").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B37").Select
    ActiveCell.FormulaR1C1 = "LUGAR y FECHA"
    Range("B41").Select
    ActiveCell.FormulaR1C1 = "FIRMA DEL OFERENTE O SU REPRESENTANTE LEGAL"
    Range("B41").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Range("B10").Select
    Columns("A:A").ColumnWidth = 10
    Range("B4:B6").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B10").Select
    Sheets("R-COMP").Select
    Sheets("R-COMP").Name = "Mano de obra"
    
'Calculo de Equipo asignado al proyecto
    Sheets("Resumen Equipo").Select
    Range("A12:J12").Select
    Selection.EntireColumn.Hidden = False
    Columns("A:A").Select
    Selection.Clear
    Selection.ColumnWidth = 5
    Range("B7:I7").Select
    Selection.EntireColumn.Delete
    Range("A1:E5").Select
    Selection.UnMerge
    Range("D4:E5").Select
    Selection.Clear
    Columns("B:E").Select
    Selection.Interior.ColorIndex = xlNone
    Selection.Font.ColorIndex = 0
    Range("B1:B5").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B1:F3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B6").Select
    Selection.EntireColumn.Delete
    Range("C6:D6").Select
    Selection.ColumnWidth = 25
    Selection.RowHeight = 55
    Range("B7:D266").Select
    Selection.ClearContents
    Range("D7:J7").Select
    Selection.EntireColumn.Insert
    Range("C6:K6").Select
    Selection.Font.Bold = False
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 13
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("C6").Select
    ActiveCell.FormulaR1C1 = "FECHA DE" & Chr(10) & "FABRICACION"
    With ActiveCell.Characters(Start:=1, Length:=20).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("D6").Select
    ActiveCell.FormulaR1C1 = "ESTADO"
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "UBICACIÓN"
    Range("E6").Select
    ActiveCell.FormulaR1C1 = "UBICACIÓN" & Chr(10) & "ACTUAL"
    With ActiveCell.Characters(Start:=1, Length:=16).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("F6").Select
    ActiveCell.FormulaR1C1 = "PROPIETARIO" & Chr(10) & "ACTUAL"
    With ActiveCell.Characters(Start:=1, Length:=18).Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("G6").Select
    ActiveCell.FormulaR1C1 = "MATRICULA No."
    Range("H6").Select
    ActiveCell.FormulaR1C1 = "DESDE :"
    Range("I6").Select
    ActiveCell.FormulaR1C1 = "HASTA :"
    Range("J6").Select
    ActiveCell.FormulaR1C1 = "PROYECTO :"
    Range("K6").Select
    ActiveCell.FormulaR1C1 = "OBSERVACIONES"
    Range("H5:J5").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.FormulaR1C1 = "EQUIPO COMPROMETIDO"
    Range("H5:J5").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("B1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 17
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B1:K1").Select
    Selection.Merge
    Range("B2").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = False
    Range("B2:B5").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "FORMULARIO No. 7"
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "NOMBRE DEL OFERENTE"
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "='Presupuesto original'!RC:RC[5]"
    Range("B4").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B5").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.FormulaR1C1 = "EQUIPO ASIGNADO AL PROYECTO"
    Range("B6").Select
    ActiveWindow.SmallScroll Down:=15
    Range("A31:A250").Select
    Selection.EntireRow.Delete
    ActiveWindow.Zoom = 70
    Range("A6").Select
    Selection.EntireRow.Insert
    Range("H5:J5").Select
    Selection.Copy
    Range("H6:J6").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("H5:J5").Select
    Selection.Clear
    Range("H6:J6").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("B5:K5").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("B2:K2").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B3:K3").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("B4:K4").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B7").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("H6:J6").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 13
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Range("H6:J6").Select
    Rows("6:6").RowHeight = 33
    Range("H6:J6").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Range("B1:K1").Select
    ActiveWindow.Zoom = 62
    Range("B7").Select
    
'CALCULO DE MANO DE OBRA
    Sheets("Mano de obra").Select
    ActiveWindow.SmallScroll Down:=18
    Range("B37:B41").Select
    Selection.Copy
    ActiveWindow.ScrollRow = 1
    Range("B10").Select
    ActiveWindow.ScrollRow = 1
   
'CALCULO DE EQUIPO ASIGNADO
    Sheets("Resumen Equipo").Select
    Range("B34").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B34:C34").Select
    Selection.Merge
    Range("B38:C38").Select
    Selection.Merge
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Range("B7").Select
    
    Range("B1:K1").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 22
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B7:K7").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    
    Columns("B:B").EntireColumn.AutoFit
    Columns("A:A").ColumnWidth = 12
      
    ActiveWindow.ScrollRow = 1
    Range("B7").Select
    
Sheets("Resumen Equipo").Select
    Sheets("Resumen Equipo").Name = "Equipo asignado"
    Range("B7").Select
    
'PRECIOS UNITARIOS CAMBIA NOMBRE
Sheets("PU Presup").Select
    'BORRA CELDAS DE LA FILA 1
    Range("F1:G1").Select
    Selection.Clear
    Range("B2:G2").Select
    Sheets("PU Presup").Name = "Precios unitarios"
    
'ELIMINA FILAS EN BLANCO
    Rows("19712:19712").Select
    Selection.Clear

    Range("O1:Q1").Select
    Selection.EntireColumn.Hidden = False
    Range("P1:P19711").Select
    Selection.AutoFilter
    Range("P1").Select
    ActiveWindow.DisplayZeros = True
    Selection.AutoFilter Field:=1, Criteria1:="1"
    ActiveWindow.SmallScroll Down:=50
    ActiveWindow.DisplayZeros = False
    Range("P1").Select
    Selection.EntireColumn.Hidden = True
    Range("B2:G2").Select
    Range("B2").Select
'----------------------------

Sheets("Presupuesto original").Select
    Sheets("Presupuesto original").Copy Before:=Sheets(3)
    Sheets("Presupuesto original (2)").Select
    Sheets("Presupuesto original (2)").Name = "Presupuesto referencial"
    ActiveWindow.SmallScroll Down:=9
    Range("F13:G35").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=21
    Range("B284:G287").Select
    Range("C284").Activate
    Selection.UnMerge
    Selection.ClearContents
    Range("C288").Select
    ActiveCell.FormulaR1C1 = "FIRMA DEL OFERENTE O SU REPRESENTANTE LEGAL"
    Range("C289").Select
    Selection.ClearContents
    Range("D289").Select
    ActiveCell.FormulaR1C1 = "LUGAR  y  FECHA"
    Range("G283").Select
    Selection.ClearContents
    Range("D283:F283").Select
    ActiveCell.FormulaR1C1 = "Presupuesto Total :"
    Range("B283:C283").Select
    ActiveCell.FormulaR1C1 = "SON ( Valor en letras )"
    
    Range("F1:G1").Select
    Selection.Clear
    Range("B2:G2").Select
    
'Copia datos de la Hoja Precios unitarios
    Sheets("Precios unitarios").Select
    Sheets("Precios unitarios").Copy Before:=Sheets(4)
    Sheets("Precios unitarios (2)").Select
    Sheets("Precios unitarios (2)").Name = "Precios unitarios (formato)"
    ActiveWindow.TabRatio = 0.841
    Range("B4:G4").Select
    Selection.Font.Bold = False
    Selection.UnMerge
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B4").Select
    ActiveCell.FormulaR1C1 = "NOMBRE DEL OFERENTE :"
    Range("B5:G5").Select
    Selection.UnMerge
    Range("B5").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.FormulaR1C1 = "='Presupuesto original'!R[-1]C:R[-1]C[5]"
    Range("F6:G6").Select
    Selection.ClearContents
    Range("F5").Select
    ActiveCell.FormulaR1C1 = "Hoja …….. de …….."
    Range("F5").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("B7").Select
    Selection.ClearContents
    Range("B6:G6").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "ANALISIS DE PRECIOS UNITARIOS"
    Range("B9:E9,G7,G8,B13:G22,G23").Select
    Range("G23").Activate
    ActiveWindow.SmallScroll Down:=20
    Range("B9:E9,G7,G8,B13:G22,G23,B26:G35,G36,B39:G49,G50").Select
    Range("G50").Activate
    ActiveWindow.SmallScroll Down:=25
    Range( _
        "B9:E9,G7,G8,B13:G22,G23,B26:G35,G36,B39:G49,G50,B53:G59,G60,G64:G67,G69,F65,F66" _
        ).Select
    Range("F66").Activate
    Selection.ClearContents
    Range("B68").Select
    ActiveCell.FormulaR1C1 = "FIRMA DEL OFERENTE O SU REPRESENTANTE"
    Range("B69").Select
    Selection.ClearContents
    Range("B71").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveCell.FormulaR1C1 = "LUGAR  y  FECHA"
    Range("A75:A19712").Select
    Selection.EntireRow.Delete
    Range("C13:G13").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("C13").Select
    ActiveCell.FormulaR1C1 = "A"
    Range("D13").Select
    ActiveCell.FormulaR1C1 = "B"
    Range("E13").Select
    ActiveCell.FormulaR1C1 = "C=A*B"
    Range("F13").Select
    ActiveCell.FormulaR1C1 = "R"
    Range("G13").Select
    ActiveCell.FormulaR1C1 = "D=C*R"
    Range("C13:G13").Select
    Selection.Copy
    Range("C26").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SmallScroll Down:=29
    Range("D39:G39").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("E39").Select
    ActiveCell.FormulaR1C1 = "A"
    Range("F39").Select
    ActiveCell.FormulaR1C1 = "B"
    Range("G39").Select
    ActiveCell.FormulaR1C1 = "C=A*B"
    Range("E39:G39").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("D53:G53").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Range("D53").Select
    ActiveCell.FormulaR1C1 = "A"
    Range("E53").Select
    ActiveCell.FormulaR1C1 = "B"
    Range("F53").Select
    ActiveCell.FormulaR1C1 = "C"
    Range("G53").Select
    ActiveCell.FormulaR1C1 = "D=A*B*C"
    Range("D53:G53").Select
    
'Bloquea HOJAS
    'Bloquea hoja Presupuesto original
    Sheets("Presupuesto original").Select
    Sheets("Presupuesto original").Name = "Presupuesto Subasta"
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ActiveWindow.ScrollRow = 1
    Range("B2:G2").Select
    ActiveSheet.Protect "XX"

'Precios unitarios
    Sheets("Precios unitarios").Select
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ActiveSheet.Protect "XX"
    ActiveWindow.ScrollRow = 1
    Range("B2:G2").Select
    
Sheets("Presupuesto referencial").Select
    Cells.Select
    Selection.Locked = True
    
Sheets("Precios unitarios (formato)").Select
    Cells.Select
    Selection.Locked = True
    Range("B2:G2").Select
    
Sheets("Cronograma valorado").Select
    ActiveWindow.ScrollRow = 1
    Range("A1").Select
    Range("C7").Select
    ActiveWindow.ScrollRow = 1
    
Sheets("Presupuesto referencial").Select
    ActiveWindow.ScrollRow = 1
    Range("F1:G1").Select
    Selection.Clear
    Range("B2:G2").Select
    
    Range("A1").Select
    Range("B2").Select
    ActiveSheet.Protect "XX"
Sheets("Precios unitarios (formato)").Select
    Range("F1:G1").Select
    Selection.Clear
    Range("B2:G2").Select
    'Borra datos de VAE
    Range("H13:L23").Select
    Selection.ClearContents
    Range("H26:L36").Select
    Selection.ClearContents
    Range("H39:L50").Select
    Selection.ClearContents
    Range("H53:L60").Select
    Selection.ClearContents
    'CAMBIA ANCHO DE COLUMNA A
    Range("A3").Select
    Columns("A:A").ColumnWidth = 19.71
    
    ActiveSheet.Protect "XX"
    ActiveWindow.ScrollRow = 1
    Range("A1").Select
    Range("B2").Select
    
Sheets("Cronograma valorado").Select
    ActiveSheet.Protect "XX"
    ActiveWindow.ScrollRow = 1
        Range("A1").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 1
    Range("C7").Select
    ActiveWindow.ScrollRow = 1
    ActiveWindow.Zoom = 60
    Sheets("Cronograma valorado").Move Before:=Sheets(4)
    
    
Sheets("Precios unitarios").Move Before:=Sheets(5)
    Sheets("Presupuesto referencial").Select
    ActiveWindow.ScrollRow = 1
    Range("A1").Select
    Range("B2").Select
    
Sheets("Presupuesto referencial").Select

Sheets("Resumen materiales").Select
    ActiveSheet.Unprotect "MC"
    Sheets("Resumen materiales").Select
    Sheets("Resumen materiales").Move After:=Sheets(8)
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    
'ELIMINA VINCULOS HOJA MATERIALES

    Range("B1:G7").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B2:G2").Select
    Application.CutCopyMode = False

    ActiveWorkbook.Sheets("Resumen materiales").Tab.ColorIndex = 2
    
    Selection.Interior.ColorIndex = xlNone
    Range("b8").Select
    
'CAMBIA NOMBRES HOJAS PRESUPUESTOS
    Sheets("Presupuesto Subasta").Select
    Sheets("Presupuesto Subasta").Name = "Contratación directa"
    Sheets("Presupuesto referencial").Select
    Sheets("Presupuesto referencial").Name = "Concursos Licitaciones"
    Sheets("Contratación directa").Select

'BLOQUEA HOJAS FORMATOS
    ActiveSheet.Unprotect "XX"
    Range("I13:P13").Select
    Selection.EntireColumn.Delete
    Range("A13").Select
    ActiveWindow.SmallScroll Down:=-30
    Range("B2:G2").Select
    ActiveSheet.Protect "XX"

Sheets("Concursos Licitaciones").Select
    ActiveSheet.Unprotect "XX"
    Range("I13:O13").Select
    Selection.EntireColumn.Delete
    Range("B2:G2").Select
    ActiveSheet.Protect "XX"

Sheets("Mano de obra").Select
    ActiveSheet.Unprotect "MC"
    Selection.Delete
    ActiveWindow.SmallScroll ToRight:=1
    Range("K12").Select
    Selection.EntireColumn.Delete
    Cells.Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("B2:J10").Select
    Range("D2").Activate
    Selection.Locked = True
    Selection.FormulaHidden = True
    Range("A1").Select
    Range("A10").Select
    Range("B10").Select
        Range("A10").Select
    Range("B10").Select

'ULTIMA CORRECCION
    ActiveSheet.Unprotect "MC"
    ActiveCell.FormulaR1C1 = "NOMBRE"
    Range("B10").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    ActiveSheet.Shapes.Range(Array("Picture 1", "Picture 2")).Select
    Selection.Delete
    ActiveSheet.Protect "XX"
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst

    Range("A1").Select
    Range("A10").Select
    Range("B10").Select
        Range("A10").Select
    Range("B10").Select

    ActiveSheet.Protect "XX"
    
Sheets("Equipo asignado").Select
    ActiveSheet.Unprotect "MC"
    Cells.Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("B1:K7").Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    Range("B7").Select
    ActiveWindow.SmallScroll Down:=20
    Range("B34:C37").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B34:C34").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("B33:D40").Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ActiveWindow.SmallScroll Down:=-45
    Range("B7").Select
    ActiveSheet.Protect "XX"
    
Sheets("Resumen materiales").Select
    ActiveSheet.Unprotect "MC"
    Cells.Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("B2:G9").Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    Range("B8:B9").Select
    ActiveWindow.SmallScroll Down:=25
    Range("B43:H49").Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    ActiveWindow.SmallScroll Down:=-40
    Range("B8:B9").Select
    ActiveSheet.Protect "XX"
    
Sheets("Mano de obra").Select
    ActiveWindow.SmallScroll Down:=30
    ActiveSheet.Unprotect "XX"
    Range("A42:B53").Select
    Selection.EntireRow.Delete
    Range("A36:K41").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("B41").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Range("B37").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B35:J35").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
       .Weight = xlThin
    End With
    Range("B37:G48").Select
    Selection.Locked = True
    Selection.FormulaHidden = True
    Range("B37").Select
    ActiveWindow.SmallScroll Down:=-55
    Range("B10").Select
    ActiveSheet.Protect "XX"
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    
    Sheets("Contratación directa").Select
    
'CALCULA AGREGADO
    Sheets("Agregado").Select
    ActiveSheet.Unprotect "MC"
    'Elimina filtros si encuentra
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    
    ActiveSheet.Shapes.Range(Array("Picture 2", "Picture 3")).Select
    Selection.Delete
    Columns("C:K").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("C4:K4").Select
    Selection.Interior.ColorIndex = xlNone
    Range("K2:M2").Select
    Selection.EntireColumn.Hidden = False
    Range("L11").Select
    Selection.AutoFilter Field:=1, Criteria1:="<>"
    Range("L11").Select
    Selection.EntireColumn.Hidden = True
    
    'CORRECCION DE VINCULOS Hoja Agregado
    Range("N4:S4").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("M12").Select
    Selection.EntireColumn.Hidden = True
    

    ActiveSheet.Protect "XX"
    Range("B11").Select
    ActiveWorkbook.Sheets("Agregado").Tab.ColorIndex = 2
    Sheets("Agregado").Select
    Sheets("Agregado").Move Before:=Sheets(3)
    
    '-----------------------------------

   
    Application.WindowState = xlMaximized

Dim ret As Long
ret = sndPlaySound("C:\windows\media\tada.wav", SND_ASYNC)
If ret = 0 Then
MsgBox "No se pudo reproducir el archivo", vbOKOnly, "¡Error!"
End If

    '-------------------------------------------
    
    
    ActiveWindow.TabRatio = 0.913
    
    
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Contratación directa").Select
    Range("B2:G2").Select

 Rem --- Aquí termina la macro ---
    
    'Fin del acelerador de la macro
    Application.Calculation = Estado  'restauro
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   'vuelve al estado de calculo automático
    Application.Calculation = xlAutomatic
    
    Unload PAISAJE
End Sub
Sub DeleteAllCode()
     
     'Trust Access To Visual Basics Project must be enabled.
     'From Excel: Tools | Macro | Security | Trusted Sources
     'Activa nuevamente el fondo PAISAJE
    PAISAJE.Show vbModeless
myTime = Now + TimeSerial(0, 0, 2)
Rem --- Cada 5 segundos repinto el formulario ---
If Now > myTime Then
PAISAJE.Repaint
myTime = Now + TimeSerial(0, 0, 2)
End If
    '------------------
     Application.ScreenUpdating = False
    Dim x               As Integer
    Dim Proceed         As VbMsgBoxResult
    Dim Prompt          As String
    Dim Title           As String
     
    On Error Resume Next
    With ActiveWorkbook.VBProject
        For x = .VBComponents.Count To 1 Step -1
            .VBComponents.Remove .VBComponents(x)
        Next x
        For x = .VBComponents.Count To 1 Step -1
            .VBComponents(x).CodeModule.DeleteLines _
            1, .VBComponents(x).CodeModule.CountOfLines
        Next x
    End With
    On Error GoTo 0
     
End Sub

 

Share this post


Link to post
Share on other sites
En ‎01‎/‎04‎/‎2016 at 15:49 , Milton Cordova dijo:

copio algunas hojas en valores , pero las macros del archivo original se siguen manteniendo en el nuevo archivo.
esto venia funcinando normalmente pero repentinamente se me presenta este problema, es alguna configuracion del excel.....?

(aparentemente) la macro que usas para eliminar módulos y líneas de código es correcta, bajo el entendido de que la configuración para confiar en el acceso a proyectos vba está habilitada

esa macro trabaja sobre 7 hojas copiadas (de un libro de base) a un libro nuevo y después regresa el control al procedimiento que la llamó, el cual...

convierte formulas a valores y elimina algunas formas (no en todas las hojas) por lo que es posible que algunas formas (agregadas después de haberse grabado la macro) se queden sin eliminar (?)

comenta (si encuentras) algún detalle mas significativo

saludos,

hector.

Share this post


Link to post
Share on other sites
Guest
This topic is now closed to further replies.



×
×
  • Create New...

Important Information

Privacy Policy


CTA Templates.png