Macro que copia formato y área de impresión
Dante amor, en una macro quiero agregar una parte que pueda copiar el formato y el área de impresión existente en un nuevo libro al cual también le copiare otras cosas
1 Respuesta
Respuesta de Dante Amor
1
Te anexo la macro actualizada
Sub OrdenDeTrabajo()
'Por.Dante Amor
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.SheetsInNewWorkbook = 1
'
Set l1 = ThisWorkbook
Set h11 = l1.Sheets("STOCK")
Set h12 = l1.Sheets("Productos")
Set h13 = l1.Sheets("Orden de Trabajo")
Set l2 = Workbooks.Add
h12.Range("A9:B200").ClearContents
ruta = l1.Path & "\"
nombre = "programa del " & Format(Date, "dd mmmm")
caras = Array(":", "\", "/", "?", "*", "[", "]")
l2.SaveAs ruta & nombre & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
j = 9
'
For i = 9 To h11.Range("A" & Rows.Count).End(xlUp).Row
If h11.Cells(i, "D") < 0 Then
cant = h11.Cells(i, "D") * -1
desc = h11.Cells(i, "A")
desc2 = desc
For k = LBound(caras) To UBound(caras)
desc2 = Replace(desc2, caras(k), "")
Next
h12.Cells(j, "A") = cant 'cant
h12.Cells(j, "B") = desc 'desc
l2.Sheets.Add
Set l21 = l2.ActiveSheet
h13.Cells.Copy
l21.[A1].PasteSpecial xlAll
Call EstablecerImpresion
'h13.Copy after:=(l2.Sheets(l2.Sheets.Count))
l21.Name = Left(desc2, 29) 'desc
l21.[B4] = Date 'fecha
l21.[f2] = cant 'cant
l21.[f1] = desc 'desc
j = j + 1
End If
Next
'
'If l2. Sheets. Count > 1 Then l2. Sheets(1).Delete
l2. Sheets(1). Activate
l2.Save 'As ruta & nombre & ".xlsx"
l2.Close
MsgBox "Orden de Trabajo guardada con el nombre : " & nombre, vbInformation, "ORDEN DE TRABAJO"
End Sub
Sub EstablecerImpresion()
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$1:$J$23"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.236220472440945)
.RightMargin = Application.InchesToPoints(0.236220472440945)
.TopMargin = Application.InchesToPoints(0.236220472440945)
.BottomMargin = Application.InchesToPoints(0.236220472440945)
.HeaderMargin = Application.InchesToPoints(0.236220472440945)
.FooterMargin = Application.InchesToPoints(0.236220472440945)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLegal
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 74
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
