Necesito ayuda con una macro que me permita cambiar el formato de una planilla de Excel.

Hola expertos...

Tengo un programa de costos y presupuestos que exporta datos a Excel sin embargo tiene un formato único y propio por lo cual para llevarlo al formato exigido y requerido, se hace un proceso un poco largo y tedioso.

Entonces necesito ayuda con una macro que me permita dar formato a la planilla de análisis de precios unitarios, en resumen deberia hacer las siguientes subrutinas:

1. Cambiar todo el texto a Arial

2. Cambiar el ancho de las columnas: B=45; C=D=E=F=G=H=10,14

3. Si alguna celda contiene el texto "ANÁLISIS DE PRECIO UNITARIO" combinar el rango desde A:H y centrar y alinear al medio

4. Centrar la columna C y ocultar las columnas E y F.

5. Si la columna A contiene algun numero del 1 al 6 colorear la fila que lo contiene en el rango A:H

6. Si alguna celda contiene el texto "CARGAS SOCIALES - % DEL SUBTOTAL DE MANO DE OBRA" combinar en el rango A:D y alienar a la derecha

7. Si alguna celda contiene el texto "CARGAS SOCIALES - % DEL SUBTOTAL DE MANO DE OBRA" combinar en el rango A:D y alienar a la derecha

8. Si la columna G contiene el texto "TOTAL PRECIO UNITARIO" insertar una celda debajo con el texto "(*) El proponente deberá señalar los porcentajes pertinentes a cada rubro." combinar esa fila en el rango A:H, alinear a la izquierda, bordes externos y tamaño de letra 8

9. Si slguna fila contiene el texto "(*) El proponente deberá señalar los porcentajes pertinentes a cada rubro." insertar DOS celda debajo con el texto "NOTA.- El proponente declara que el presente formulario ha sido llenado de acuerdo con las especificaciones técnicas, aplicando las leyes sociales y tributarias vigentes." combinar AMBAS fila en el rango A:H, alinear a la izquierda, bordes externos y tamaño de letra 8

AJUNTO IMAGEN, la misma que en la izquierda muestra el formato obtenido del programa y a la derecha el formato deseado a modo de comparación.

De antemano, muchisimas gracias.

1 Respuesta

Respuesta
1

Te anexo la macro para formatear la plantilla.

Sub formato()
'Por.Dante Amor
    Cells.Font.Name = "Arial"
    Columns("B:B").ColumnWidth = 45
    Columns("C:H").ColumnWidth = 10.14
    Columns("C:C").HorizontalAlignment = xlCenter
    Columns("E:F").EntireColumn.Hidden = True
    For i = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row To 1 Step -1
        If Cells(i, "A") >= 1 And Cells(i, "A") <= 6 Then
            Range("A" & i & ":H" & i).Select
            With Selection.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.149998474074526
                .PatternTintAndShade = 0
            End With
        End If
        For j = 1 To 8
            Select Case Cells(i, j)
            Case "ANÁLISIS DE PRECIO UNITARIO"
                Range("A" & i & ":H" & i).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
            Case "CARGAS SOCIALES - % DEL SUBTOTAL DE MANO DE OBRA", _
                "IMPUESTOS IVA MANO DE OBRA - % DE SUMA DE SUBTOTAL DE (MO+CS)"
                Range("A" & i & ":D" & i).Select
                Selection.Merge
                With Selection
                    .HorizontalAlignment = xlRight
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                End With
            Case "TOTAL PRECIO UNITARIO"
                Rows(i + 1 & ":" & i + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + 1, "A") = "(*) El proponente deberá señalar los porcentajes pertinentes a cada rubro."
                Range("A" & i + 1 & ":H" & i + 1).Select
                Selection.Merge
                With Selection
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlBottom
                    .WrapText = False
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                    .Font.Size = 8
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThin
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThin
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThin
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThin
                End With
                Rows(i + 2 & ":" & i + 3).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + 2, "A") = "NOTA.- El proponente declara que el presente formulario ha sido llenado de acuerdo con las especificaciones técnicas, aplicando las leyes sociales y tributarias vigentes."
                Range("A" & i + 2 & ":H" & i + 3).Select
                Selection.Merge
                With Selection
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlBottom
                    .WrapText = True
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .ReadingOrder = xlContext
                    .MergeCells = True
                    .Font.Size = 8
                    .Borders(xlEdgeLeft).LineStyle = xlContinuous
                    .Borders(xlEdgeLeft).Weight = xlThin
                    .Borders(xlEdgeTop).LineStyle = xlContinuous
                    .Borders(xlEdgeTop).Weight = xlThin
                    .Borders(xlEdgeBottom).LineStyle = xlContinuous
                    .Borders(xlEdgeBottom).Weight = xlThin
                    .Borders(xlEdgeRight).LineStyle = xlContinuous
                    .Borders(xlEdgeRight).Weight = xlThin
                End With
            End Select
        Next
    Next
End Sub

Revisa el funcionamiento, si hay algún detalle avísame.

Saludos. Dante Amor

Si es lo que necesitas. No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Bordes con macro

Recurro a ustedes una vez mas. Tengo una simple macro que dibuja bordes negros en el exterior y grises en el interior ( un formato que uso muy habitualmente ) Funciona correctamente salvo en la ocasión en que solo tenga seleccionada una sola celda:...
1 respuesta

DIBUJAR CELDAS con macros

Tengo una Base de Datos en la que estoy asignando valores por medio de un UserForm de la sig forma: ActiveCell = TextBox1 '(TextBox2, ComboBox1, etc, etc..) El UserForm llena toda una fila de mil columnas en la base de datos. Y me gustaría poner una...
1 respuesta

Macro que Crea PDF y Envía El PDF por Outlook

De la manera más amable solicito ayuda, ya he creado una macro que me permite hacer un archivo en PDF, lo que requiero es que el archivo que fue creado sea enviado vía por medio de Outlook. Adjunto código de la macro para crear el PDF. Sub...
1 respuesta