Jump to content

Milton Cordova

Members
  • Content Count

    286
  • Joined

  • Last visited

  • Days Won

    1

Everything posted by Milton Cordova

  1. Saludos mil disculpas por mi insuficciencia de conocimientos, he intentado lo que me sugieres pero no funciona el cambio de color a la fuente del rando d2:d25 adjunto archivo Gracias multi-fc (ayudaExcel)-1.xls
  2. archivo para el debate formato c. miltiple multi-fc (ayudaExcel).xls
  3. Saludos la macro no fucniona o no se aplica a los datos. Quiza me podrias explicar mejor el manejo Gracias
  4. Sañudos cual seria la macro para que esto funcione Gracias
  5. Saludos necesito ayuda para formato convencional con 5 o mas criterios, segun el archivo subido para Excel 2003 Gracias FORMATO CONDICIONAL MULTIPLE.xls
  6. saludos excelente ayuda me ha servido totalmente Doy por solucionado y cerrado el tema Gracias
  7. Saludos mediante una macro creo otro archivo nuevo con algunas hojas del archivo original. Deseo eliminar en tres hojas el filtro repectivo, tengo este codigo pero no me funciona If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData Gracias
  8. 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
  9. Voy a tratar de adecuar un archivo mas pequeño para consulta, pues el que tengo es de 110 mg gracias
  10. 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
  11. Saludos tengo una macro que se dispara cuando cambia el valor de una celda B3, esta macro inicialmete desprotege la Hoja con la clave "XX" y al final vuelve a proteger la misma con la clave "XX". 1 el problema que tengo es que cuando deseo trabajar en la hoja la desprotejo y cualquier cambio o change que realizo en cualquier otra celda diferente a B3 la hoja se protege y no me deja seguir trabajando. 2 Otro problema no me permite copiar y pegar 3 si deseo que la macro funcione solamente para la columna "H" como quedaria la macro Set area = Range("G:H") If Range("b3") <> Empty Then Set area = Range("G:H") Archivo subido "HOJA PROTEGIDA CON CAMBIO DE CELDA" HOJA PROTEGIDA CON CAMBIO DE CELDA.xls
  12. Saludos ha sido muy valioso el aporte la ayuda, siempre se aprende mas cada dia, gracias a ustedes y a ti Hector Miguel en este caso Doy por solucionado el tema Gracias
  13. Saludos he revissdo en la Hoja 2 del ejemplo y no funciona, favor verificar, me parece que tiene que ver con al CurrentRegion que solamente reconoce una rango, cuando hay celdas en blanco no salta. investigando hhe llegado a probar con esto pero no funaciona Set area = Range("d5").UsedRange.Address(RowAbsolute:=True, ColumnAbsolute:=True, ReferenceStyle:=xlD5) mil disculpas por esta pregunta nuevamente, favor verificar la Hoja 2 del archivo que lo subo actualizado. Otra pregunta porque en la Hoja 1 no me permite copiar y pegar Gracias
  14. 8"]saludos deseo ayuda para alguna macro que me muestre en las columnas G y H de una planilla de calculo, el numero de decimales conforme al numero ingresado en la celda B3. si en la celda B3 esta 2 el numero de formato de numeros de las columnas debe estar con 2 decimales, si el valor de B3 es 5 debe mostrase 5 decimales, etc. he subido un ejemplo "mostrar Numero de decimales" Otra pregunata en la Hoja 1 se ha desactivado la funcion copiar pegar Gracias
  15. Saludos he revissdo en la Hoja 2 del ejemplo y no funciona, favor verificar, me parece que tiene que ver con al CurrentRegion que solamente reconoce una rango, cuando hay celdas en blanco no salta. mil disculpas por esta pregunta nuevamente, favor verificar la Hoja 2 del archivo que lo subo actualizado. Gracias
  16. Saludos tengo una consulta mas, me olvide de indicar que los decimales deben afectar a todos los numeros existentes en las columnas G,H. por cuanto tengo un numero grande de plantillas de calculo que llega hasta la fila 35505 Otra situacion la Hoja 1 se ha bloqueado la opcion de copiar y pegar es por ello que envio el ejemplo en la Hoja 2 Gracias MOSTRAR NUMERO DECIMALES.xls
  17. saludos deseo ayuda para alguna macro que me muestre en las columnas G y H de una planilla de calculo, el numero de decimales conforme al numero ingresado en la celda B3. si en la celda B3 esta 2 el numero de formato de numeros de las columnas debe estar con 2 decimales, si el valor de B3 es 5 debe mostrase 5 decimales, etc. he subido un ejemplo "mostrar Numero de decimales" Gracias MOSTRAR NUMERO DECIMALES.xls
  18. Mil disculpas por insistir en algo: tengo un grupo de 30 archivos, los cuales los abro independientemente cada vez, y estos estan direccionados cada uno para abrirse en hojas que se han seleccionado para su uso. De vez en cuando necesito abrir todos los 30 archivos, pero esta vez necesito que se abran en la Hoja SEG, esta hoja tiene cada uno de los 30. me parece dificil encontrar una solucion de todas maneras solicito ayuda, para esto Gracias
  19. Saludos estimados masters, deseo ayuda para cuando esten abiertos varios archivos y todos contienen una hoja llamada SEG luego de abrirlos mediante alguna instruccion o macro se seleccione la Hoja SEG Gracias
  20. Ok Marco Antonio, yo estaba probando con Set KeyCells = Range("A5", "B6") y me daba error. Gracias todos los días de aprende gracias a personas como tu. Doy por solucionado el tema
  21. Saludos deseo ejecutar una macro cuando se cambien 2 celdas, encontre una macro para un rango, pero deseo que sea para la celda A5 y B6 gracias Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range ' The variable KeyCells contains the cells that will ' cause an alert when they are changed. Set KeyCells = Range("A1:C10") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then ' aqui va la macro End If End Sub
  22. Saludos excelente ayuda gracias una vez mas Doy por solucionado el tema
  23. Disculpas por no haberme explicado bie´n, lo que deseo es que regrese a la hoja en la que me encuento actualmente desde donde disparo la macro, porque de la manera que palnteas siempre regresara a la Hoja 1 Gracias
  24. Saludos como puedo lograr mediante una macro lo siguiente: al ajecutar una macro desde una Hoja cualquiera este calculo de realiza en otras hojas por ejem si estoy el la Hoja 1 disparo la macro la cual realiza calculos en la hoja 3, deseo que al final se posicione al la hoja en la cuel estuve esdecir la Hoja 1, asi de cualquier hoja que regrese a esa hoja en la cual me encontraba. Gracias
  25. [plain] Saludos la pagina del Foro de Macros solo visualiza los temas pendientes, no se puede ver los temas solucionados. Gracias [/plain]
×
×
  • Create New...

Important Information

Privacy Policy